I'm looking to clean up a macro I made...

[jjacks60]

Sub PasteRCdata()        Dim ws As Worksheet    Dim WsFc As Worksheet    Dim cell As Range    Dim Lastrow As Long    Dim X As Integer

    Set ws = Workbooks("Raw Data Production").Worksheets("Production Data") 'Raw Production Data    Set WsFc = Workbooks("Raw Data Production").Worksheets("Raw Data") 'Destination of Raw Data         Lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row 'Setting last row of column A to use as lower bound X        For X = 1 To Lastrow        If cells(X, 1).Interior.ColorIndex = 6 Then        ' If the cell is yellow AND            If cells(X, 1).Value <> "" Then            'AND if the cell does not contain 'nothing'                cells(X, 1).Offset(2, 12).Select                'Then offset the cell by this exact amount every time... If this can be acheived without offset then that's okay                    If ActiveCell.Interior.ColorIndex = 34 Then                    'If this cell is light blue then I want it to copy and paste into the workbook WsFc.Range("B" & Rows.Count).End(xlUp).Offset(1).Select                    Range(Selection, Selection.End(xlToRight)).Select                        Application.CutCopyMode = False                        Selection.Copy Destination:=Workbooks("Raw Data Production").Worksheets("Raw Data") _                        .Range("B" & Rows.Count).End(xlUp).Offset(1, 0)                        'Here I want to add all cells to the right to copy and paste IF they are light blue, then transpose them into column B...                    End If            End If        End If    Next XEnd Sub

With regard to cleaning this up, anyone that has a keen eye do you see anything I can connect; Should there maybe be a function to reference from a lower sub would that help?

I tried to label what everything is doing with text.

I'm new to building code and I finally got this to work, so I'm not trying to mess it up.

If you also know how to transpose this paste function to keep values/format and skip blanks that would be amazing - it would also shorten the code I think.
"Range(Selection, Selection.End(xlToRight)).Select Application.CutCopyMode = False
Selection.Copy Destination:=Workbooks("Raw Data Production").Worksheets("Raw Data") _
.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)"

</div>

 

[hiker95]

jjacks60,

To start off can you re-post your macro code?


When posting VBA code, please use Code Tags - like this:

[code=rich]

'Paste your code here.

[/code]

 

[jjacks60]

jjacks60,

To start off can you re-post your macro code?


When posting VBA code, please use Code Tags - like this:

[code=rich]

'Paste your code here.

[/code]

Sub PasteRCdata()
    
    Dim ws As Worksheet
    Dim WsFc As Worksheet
    Dim cell As Range
    Dim Lastrow As Long
    Dim X As Integer
    Dim MsgBoxResult As Long


    MsgBoxResult = MsgBox("Do NOT exctract data more than once per day - leads to data duplication errors", vbOKCancel, "Warning")
        If MsgBoxResult = vbCancel Then
        Exit Sub
        ElseIf MsgBoxResult = vbOK Then
    
    
    Set ws = Workbooks("Raw Data Production").Worksheets("Production Data") 'Raw Production Data
    Set WsFc = Workbooks("Raw Data Production").Worksheets("Raw Data") 'Destination of Raw Data
     
    Lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row 'Setting last row of column A to use as lower bound X
    
    For X = 1 To Lastrow
        If cells(X, 1).Interior.ColorIndex = 6 Then
        ' If the cell is yellow AND
            If cells(X, 1).Value <> "" Then
            'AND if the cell does not contain 'nothing'
                cells(X, 1).Offset(2, 12).Select
                'Then offset the cell by this exact amount every time... If this can be acheived without offset then that's okay
                    If ActiveCell.Interior.ColorIndex = 34 Then
                    'If this cell is light blue then I want it to copy and paste into the workbook WsFc.Range("B" & Rows.Count).End(xlUp).Offset(1).Select
                    Range(Selection, Selection.End(xlToRight)).Select
                        Application.CutCopyMode = False
                        Selection.Copy Destination:=Workbooks("Raw Data Production").Worksheets("Raw Data") _
                        .Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
                        'Here I want to add all cells to the right to copy and paste IF they are light blue, _
                        then transpose them into column B...
                    End If
            End If
        End If
    Next X
    WsFc.Select
    End If
End Sub

Wow sorry I had no idea it would post like that.

Again though just looking to shorten the code, maybe add a few sub that I can reference (like the message box I think), and figure out how to change the current copy paste method to a paste special that transposes and skips blanks IF the cell is light blue.

 

[Michael M]

Maybe this... UNTESTED
It looks like you are working in the one workbook...if that is the case it can be shortened further

Sub PasteRCdata()
Dim ws As Worksheet, WsFc As Worksheet, cell As Range
Dim Lastrow As Long, X As Integer, MsgBoxResult As Long
MsgBoxResult = MsgBox("Do NOT exctract data more than once per day - leads to data duplication errors", vbOKCancel, "Warning")
    If MsgBoxResult = vbCancel Then Exit Sub
Set ws = Workbooks("Raw Data Production").Worksheets("Production Data") 'Raw Production Data
Set WsFc = Workbooks("Raw Data Production").Worksheets("Raw Data") 'Destination of Raw Data
Lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row 'Setting last row of column A to use as lower bound X
For X = 1 To Lastrow
    If Cells(X, 1).Interior.ColorIndex = 6 And Cells(X, 1).Value <> "" Then
            Cells(X, 1).Offset(2, 12).Select
                If Cells(X, 1).Offset(2, 12).Interior.ColorIndex = 34 Then
                Rows(X).Copy Destination:=Workbooks("Raw Data Production").Worksheets("Raw Data").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
                End If
    End If
Next X
WsFc.Select
End Sub