Jump to content
Welcome Guest!

Join us now to get access to all our features. Once registered and logged in, you will be able to create topics, post replies to existing threads, give reputation to your fellow members, get your own private messenger, and so, so much more. It's also quick and totally free, so what are you waiting for?

Leaderboard


Popular Content

Showing most liked content since 07/18/2017 in all areas

  1. 1 point
    Hey Caleeco! Thanks for the added error message, everything is up and running now. This will be a huge timesaver! Doing this manually everytime was getting tedious
  2. 1 point
    Hi Geeperz, Apologies, I dont know why it stripped out that syntax! New board...got a few things to fix! I just tested the code below, and it works on my end. The Code you uploaded wasnt working as the loop statement should be Loop While rFound.Address FirstAddress Working code: Sub TransposeData2() Application.ScreenUpdating = False Dim rFound As Range Dim FirstAddress As String Dim lC As Long 'Count variable for the rows lC = 0 Worksheets("Combine Sheet").Activate With Worksheets("Combine Sheet").Columns("C:C") Set rFound = .Find(What:="Make", After:=Range("C" & Rows.Count), LookIn:=xlValues, _ lookat:=xlWhole, Searchorder:=xlByRows, Searchdirection:=xlNext, MatchCase:=False) If Not rFound Is Nothing Then 'Value has been found FirstAddress = rFound.Address lC = Worksheets("Extract").Range("A" & Rows.Count).End(xlUp).Row Do rFound.Select 'Add post processing If rFound.Offset(0, 1) = vbNullString Then 'There is some data missing Range(rFound.Offset(1, 1), rFound.Offset(1, 1).End(xlDown)).Copy Worksheets("Extract").Range("A" & lC).Offset(1, 1).PasteSpecial Paste:=xlValues, Transpose:=True lC = lC + 1 Else Range(rFound.Offset(0, 1), rFound.Offset(0, 1).End(xlDown)).Copy Worksheets("Extract").Range("A" & lC).Offset(1, 0).PasteSpecial Paste:=xlValues, Transpose:=True lC = lC + 1 End If Set rFound = .FindNext(After:=rFound) Loop While rFound.Address FirstAddress Else 'Value has NOT been found Exit Sub End If End With Application.CutCopyMode = False Application.ScreenUpdating = False End Sub Thanks for your patience Regards Caleeco
×