Help adding If or Skip functionality to VBA Code

[ridradny]

Hi,

I have managed to alter some existing VBA code thanks to forum members help and lots of googling. The macro allows me to copy and paste data from multiple sheets into one consolidated sheet based on column headers. I'm very new to VBA.

Sometimes the sheets that are being copied do not contain all of the column headers "TransCol(j)" that I have identified resulting in an error of "Object Variable or With Block variable not set"
My workaround currently is to go through each sheet and simply add the column headers that are missing, however I'm hoping that I can add to my current macro to skip the TransCol that are not found.
The code I have currently is below:

Sub ertdfgcvb()
ExportWS = "DOH_Combine"
Dim ImportWS(1 To 9) As String
    ImportWS(1) = "Public"
    ImportWS(2) = "Newborn"
    ImportWS(3) = "Transfers In"
    ImportWS(4) = "Transfers Out"
    ImportWS(5) = "Rehab"
    ImportWS(6) = "Onc Chemo"
    ImportWS(7) = "Renal"
    ImportWS(8) = "NHTP"
    ImportWS(9) = "Palliative"




Dim TransCol(1 To 64) As String
    TransCol(1) = "B"
    TransCol(2) = "C"
    TransCol(3) = "D"
    TransCol(4) = "A2"
    TransCol(5) = "A3"
    TransCol(6) = "A4"
    TransCol(7) = "A5"
    TransCol(8) = "A6"
    TransCol(9) = "A7"
    TransCol(10) = "A8"
    TransCol(11) = "A9"
    TransCol(12) = "A10"
    TransCol(13) = "A11"
    TransCol(14) = "A12"
    TransCol(15) = "A13"
    TransCol(16) = "A14"
    TransCol(17) = "A15"
    TransCol(18) = "A16"
    TransCol(19) = "A17"
    TransCol(20) = "A18"
    TransCol(21) = "A19"
    TransCol(22) = "A20"
    TransCol(23) = "A21"
    TransCol(24) = "A22"
    TransCol(25) = "A23"
    TransCol(26) = "A24"
    TransCol(27) = "A25"
    TransCol(28) = "A26"
    TransCol(29) = "A27"
    TransCol(30) = "A28"
    TransCol(31) = "A29"
    TransCol(32) = "A30"
    TransCol(33) = "A31"
    TransCol(34) = "A32"
    TransCol(35) = "A33"
    TransCol(36) = "A34"
    TransCol(37) = "A35"
    TransCol(38) = "A36"
    TransCol(39) = "A37"
    TransCol(40) = "A40"
    TransCol(41) = "A41"
    TransCol(42) = "A42"
    TransCol(43) = "A43"
    TransCol(44) = "A44"
    TransCol(45) = "A62"
    TransCol(46) = "A63"
    TransCol(47) = "A61"
    TransCol(48) = "A54"
    TransCol(49) = "A51"
    TransCol(50) = "A64"
    TransCol(51) = "A45"
    TransCol(52) = "A46"
    TransCol(53) = "A47"
    TransCol(54) = "A48"
    TransCol(55) = "A49"
    TransCol(56) = "A50"
    TransCol(57) = "A52"
    TransCol(58) = "A53"
    TransCol(59) = "A55"
    TransCol(60) = "A56"
    TransCol(61) = "A57"
    TransCol(62) = "A58"
    TransCol(63) = "A59"
    TransCol(64) = "A60"


For i = 1 To 9 'for each import sheet
    FirstImportRow = Worksheets(ImportWS(i)).Cells.Find(TransCol(1), SearchOrder:=xlByRows, SearchDirection:=xlNext).Row + 2
    LastImportRow = Worksheets(ImportWS(i)).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    DiffRows = LastImportRow - FirstImportRow
    FirstExportRow = Worksheets(ExportWS).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    ExportColumn = Worksheets(ExportWS).Cells.Find("Sheet Name", SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the sheet name
    Worksheets(ExportWS).Range(Cells(FirstExportRow, ExportColumn), Cells(FirstExportRow + DiffRows, ExportColumn)) = ImportWS(i)
    For j = 1 To 64 'for each column that has to be transported
        ExportColumn = Worksheets(ExportWS).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data
        ImportColumn = Worksheets(ImportWS(i)).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data from
        For k = 0 To DiffRows
            Worksheets(ExportWS).Cells(FirstExportRow + k, ExportColumn) = Worksheets(ImportWS(i)).Cells(FirstImportRow + k, ImportColumn)
        Next
    Next


Next
End Sub

Any suggestions or a point in the right direction would be much appreciated.

 

[Akuini]

This is untested:

    For j = 1 To 64 'for each column that has to be transported
        ExportColumn = Worksheets(ExportWS).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data
        ImportColumn = Worksheets(ImportWS(i)).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data from
        [COLOR=#0000ff]If Not ImportColumn Is Nothing Then[/COLOR]
        For k = 0 To DiffRows
            Worksheets(ExportWS).Cells(FirstExportRow + k, ExportColumn) = Worksheets(ImportWS(i)).Cells(FirstImportRow + k, ImportColumn)
        Next
       [COLOR=#0000ff] End If[/COLOR]
    Next

 

[Akuini]

Sorry, I thought ImportColumn is a range. Try this one instead:

Dim c As Range   
    For i = 1 To 9 'for each import sheet
    FirstImportRow = Worksheets(ImportWS(i)).Cells.Find(TransCol(1), SearchOrder:=xlByRows, SearchDirection:=xlNext).Row + 2
    LastImportRow = Worksheets(ImportWS(i)).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    DiffRows = LastImportRow - FirstImportRow
    FirstExportRow = Worksheets(ExportWS).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    ExportColumn = Worksheets(ExportWS).Cells.Find("Sheet Name", SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the sheet name
    Worksheets(ExportWS).Range(Cells(FirstExportRow, ExportColumn), Cells(FirstExportRow + DiffRows, ExportColumn)) = ImportWS(i)

    For j = 1 To 64 'for each column that has to be transported
        ExportColumn = Worksheets(ExportWS).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data
        Set c = Worksheets(ImportWS(i)).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not c Is Nothing Then
        ImportColumn = c.Column 'defines where to insert the data from
        For k = 0 To DiffRows
            Worksheets(ExportWS).Cells(FirstExportRow + k, ExportColumn) = Worksheets(ImportWS(i)).Cells(FirstImportRow + k, ImportColumn)
        Next
        End If
    Next


Next

 

[ridradny]

Thanks Akuini,

That worked perfectly.

I am now trying to do similar to how you have defined a range so that I can exclude the code from importing data from sheets where no data is present. Am I on the right track in thinking this can be done the same way as excluding column headers that are not present?

Thank you in advance

 

[Akuini]

Yes, this line tell the code find the header:
Set c = Worksheets(ImportWS(i)).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext)

then we check using this line:
If Not c Is Nothing Then

if it is found then it continues to the next line otherwise the code will jump directly to "End If"

Note:
The header is in row 1, isn't it? If yes, then you can narrow down the search part to row 1 only, like this:

Set c = Worksheets(ImportWS(i)).Rows(1).Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext)

Using .Cells.Find, means you search the entire sheet