CODEWITHSUNDEEP
vbaexcel
OzZie
OzZie

Reputation: 523

Search on specific row for value, copy entire column to another sheet

Hei guys, im facing a problem with vba code that should look ONLY on a specific row for a value, startting from "row 7 column A" (for example) untill "row 7 last column that sheet has".

What i try to achieve:

A button on excel that has code VBA to open an input dialog. By value given in input i should search ONLY! on specific row (only 1 row). I start searching by value on that row starting with column A of that row and i need to loop untill last cell from that row.

If the code finds the value on C7 for example, row 7 column C, i need to copy the entire column to another sheet and start looking again for the value starting from last found cell. So if the code finds another column that contains on row 7 column G, do the thing again.

The thing is, if there are multiple columns found, on the sheet that i paste em should be the first column the code finds on column A, then second column that code finds on column B... and so on.

What i have done so far: 

Sub bydepartment_Click()

    Dim value1 As Variant
    value1 = InputBox("Find the column by department.", "Report by department")
    If value1 = Empty Then
        Exit Sub
    End If

    Dim Found As Range, LastRow As Long
    Dim ColoanaToAdd As String
    Dim emptyOne As String
    Dim destination As Worksheet
    Dim emptyColumn As String
    Dim var As String
    Dim Coloana As String

    With Worksheets("DAT").Range("A1:QUY1")

    Sheets(value1).Cells.Clear

    Set Found = Sheets("DAT").Rows(5).Find(What:=value1, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Found Is Nothing Then
            firstAddress = Found.Address
        Do

    LastRow = Cells(Rows.Count, Found.Column).End(xlUp).Row

    Select Case Found.Column
        Case 1
        Coloana = "A"
        Case 2
        Coloana = "B"
        Case 3
        Coloana = "C"
        Case 4
        Coloana = "D"
        Case 5
        Coloana = "E"
        Case 6
        Coloana = "F"
        Case 7
        Coloana = "G"
        Case 8
        Coloana = "H"
        Case 9
        Coloana = "I"
        Case 10
        Coloana = "J"
        Case 11
        Coloana = "K"
        Case 13
        Coloana = "L"
        Case 14
        Coloana = "M"
        Case 15
        Coloana = "N"
        Case 16
        Coloana = "O"
        Case 17
        Coloana = "P"
    End Select

    Set destination = Sheets(value1)
    emptyColumn = destination.Cells(5, destination.Columns.Count).End(xlToLeft).Column + 1

    If emptyColumn > 1 Then
        emptyColumn = emptyColumn
    End If

    Select Case emptyColumn
        Case 1
        var = "A"
        Case 2
        var = "B"
        Case 3
        var = "C"
        Case 4
        var = "D"
        Case 5
        var = "E"
        Case 6
        var = "F"
        Case 7
        var = "G"
        Case 8
        var = "H"
        Case 9
        var = "I"
        Case 10
        var = "J"
        Case 11
        var = "K"
        Case 13
        var = "L"
        Case 14
        var = "M"
        Case 15
        var = "N"
        Case 16
        var = "O"
        Case 17
        var = "P"
    End Select

    emptyOne = var & 1 & ":" & var

    ColoanaToAdd = Coloana & 1 & ":" & Coloana

    Sheets(value1).Range(emptyOne & LastRow).Value = Sheets("DAT").Range(ColoanaToAdd & LastRow).Value

    MsgBox "Your report was created"

    Set Found = Sheets("DAT").Rows(5).FindNext(Found)
        Loop While Not Found Is Nothing And Found.Address <> firstAddress
    End If
   End With

End Sub

I hardcoded with cases for few columns... i know :( but i guess and i know there is a better way of doing that ...

Thanks in advance guys!

Upvotes: 0

Views: 2671

Answers (2)

Vignesh Shankar
Vignesh Shankar

Reputation: 44

Try this code @ozZie. This is include the formulae and the case sensitive issue

Sub CopynPasteColumns()
 Dim sh1 As Worksheet, sh2 As Worksheet
 Dim K As Long, i As Long, nRow As Long
 Dim valuee1 As Variant

 Set sh1 = Sheets("Sheet1")
 Set sh2 = Sheets("Sheet2")
 K = 1
 nRow = 7
 valuee1 = InputBox("Find the column by department.", "Report by department")

 For i = 1 To sh1.UsedRange.Columns.Count
     If LCase(sh1.Cells(nRow, i).Value) = LCase(valuee1) Then
         sh1.Cells(nRow, i).EntireColumn.Copy
         sh2.Cells(1, K).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
         K = K + 1
     End If
 Next i
End Sub

Upvotes: 0

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

This may be able to help you. The code looks for some value (happiness) in row #7 of Sheet1. if found, then that entire column in Sheet1 is copied to Sheet2.

The code loops through all the cells in row #7 of Sheet1

Sub OzZie()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim K As Long, i As Long, nRow As Long
    Dim valuee1 As Variant

    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    K = 1
    nRow = 7
    valuee1 = "happiness"

    For i = 1 To Columns.Count
        If sh1.Cells(nRow, i).Value = valuee1 Then
            sh1.Cells(nRow, i).EntireColumn.Copy sh2.Cells(1, K)
            K = K + 1
        End If
    Next i
End Sub

Upvotes: 2

Related Questions