Excel VBA Macro Help. Copying data from one sheet to others based on certain criteria

[spekul8r]

Hello,

I need some VBA macro help, I have been unable to figure out a good solution on my own. I currently have a workbook with 4 Sheets. Data is imported into the first sheet named Data. It contains 5000+ rows and populates data in columns A thru G. I then need to examine each row in column A and if it starts with a @ then it along with columns B thru G needs to be copied into a sheet called “Result1”, if it starts with a $ then the same thing happens but it is copied into a sheet called “Result2” and finally if it starts with anything but @ or $ it gets copied into a third sheet called “Result3”. Before this macro copies the data it also needs to clear out columns A thru G on the Results sheets but not clear them entirely because there are formulas in the columns after G.

If anyone could help me or point me in the correct direction it, I would greatly appreciate it.

Thanks,

Mike

 

[SQUIDD]

Hi Mike

This all seems to sound quite simple.
I will have a go for you if you like.
Will post back some code in bit.

Unless you want to do it yourself and do only require pointers?

Dave

 

[JLGWhiz]

Give it a try on a copy or mock up first.

Sub results()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, fc1 As String, fc2 As String
Set sh1 = Sheets("Data")
Set sh2 = Sheets("Results1")
Set sh3 = Sheets("Results2")
Set sh4 = Sheets("Results3")
sh2.Range("A:G").ClearContents
sh3.Range("A:G").ClearContents
sh4.Range("A:G").ClearContents
With sh1
    fc1 = "@"
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, fc1 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh2.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
    fc2 = "$"
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, fc2 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh3.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, "<>" & fc1 & "*", xlAnd, "<>" & fc2 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh4.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
End With
End Sub

 

[spekul8r]

Thank you so much, that works great, it is exactly what I needed. Another quick question, if on the sheets I want to clear I want to start at row 3 so to not erase the headers how would I change the code? I tried sh2.Range("A3:G").ClearContents but I got an error message.

 

[SQUIDD]

Hi

There may be a better way than this, usually i do it by finding the lastrow in the column, but i thought of using a counter, but now thinking about it, if you had balnk data in column A, then this will not work.

I will post the code anyway and re-post the lastrow cod after also.

Good job JLGWhiz BTW

Sub results()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, fc1 As String, fc2 As String
Set sh1 = Sheets("Data")
Set sh2 = Sheets("Results1")
Set sh3 = Sheets("Results2")
Set sh4 = Sheets("Results3")
counter1 = Application.WorksheetFunction.CountA(Range("'Results1'!a:a"))
counter2 = Application.WorksheetFunction.CountA(Range("'Results2'!a:a"))
counter3 = Application.WorksheetFunction.CountA(Range("'Results3'!a:a"))
sh2.Range("A3:G" & counter1).ClearContents
Stop
sh2.Range("A3:G" & counter2).ClearContents
sh2.Range("A3:G" & counter3).ClearContents
With sh1
    fc1 = "@"
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, fc1 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh2.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
    fc2 = "$"
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, fc2 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh3.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, "<>" & fc1 & "*", xlAnd, "<>" & fc2 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh4.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
End With
End Sub

 

[SQUIDD]

I believe this will be the correct/best way

dave

Sub results()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, fc1 As String, fc2 As String
Dim LastRow2 As Long
Dim LastRow3 As Long
Dim LastRow4 As Long
Set sh1 = Sheets("Data")
Set sh2 = Sheets("Results1")
Set sh3 = Sheets("Results2")
Set sh4 = Sheets("Results3")
  LastRow2 = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row
  LastRow3 = sh3.Cells(sh3.Rows.Count, "A").End(xlUp).Row
  LastRow4 = sh4.Cells(sh4.Rows.Count, "A").End(xlUp).Row
sh2.Range("A3:G" & LastRow2).ClearContents
sh3.Range("A3:G" & LastRow3).ClearContents
sh4.Range("A3:G" & LastRow4).ClearContents
With sh1
    fc1 = "@"
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, fc1 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh2.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
    fc2 = "$"
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, fc2 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh3.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, "<>" & fc1 & "*", xlAnd, "<>" & fc2 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh4.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
End With
End Sub

 

[JLGWhiz]

Thank you so much, that works great, it is exactly what I needed. Another quick question, if on the sheets I want to clear I want to start at row 3 so to not erase the headers how would I change the code? I tried sh2.Range("A3:G").ClearContents but I got an error message.

Sub results()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, fc1 As String, fc2 As String
Set sh1 = Sheets("Data")
Set sh2 = Sheets("Results1")
Set sh3 = Sheets("Results2")
Set sh4 = Sheets("Results3")
sh2.Range("A3:G3").Resize(Rows.Count - 3).ClearContents
sh3.Range("A3:G3").Resize(Rows.Count - 3).ClearContents
sh4.Range("A3:G3").Resize(Rows.Count - 3).ClearContents
With sh1
    fc1 = "@"
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, fc1 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh2.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
    fc2 = "$"
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, fc2 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh3.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, "<>" & fc1 & "*", xlAnd, "<>" & fc2 & "*"
    .Range("A2", .Cells(Rows.Count, 7).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
        sh4.Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
End With
End Sub

 

[spekul8r]

Thank you very much, that is exactly what I needed. I definitely need to learn more VBA.

 

[JLGWhiz]

Thank you very much, that is exactly what I needed. I definitely need to learn more VBA.

You're welcome,
regards, JLG

 

[smfrankel]

Going out of my mind and I have to believe this is simple. I have a worksheet with multiple tabs. Some of the Tabs are names "Room 1" "Room 2", etc. i am in a new tab and i want a particular cell in this new tab to show me one of the OTHER (nonactive) Tab Names. Again, to clarify I am in a Tab named NEW and in cell B12 I want the Tab named Room 2 to appear in there and change in the NEW tab if I change the name room Room 2 to Tulip

i'm sure this is so simple but i'm lost. Please help!