2

I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").

So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!

Sub Test()
'
' Test Macro
'

  Sheets("2").Select

For Each Cell In Sheets(1).Range("G:G")
    If Cell.Value = "" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

        Sheets("Core_Cutting_List").Select
        ActiveSheet.Rows(matchRow).Select
        ActiveSheet.Paste
        Sheets("2").Select
    End If
Next
End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
Melnemac32
  • 41
  • 3

2 Answers2

0

If you need two conditions, then you should write them carefully in the IF statement with And:

Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.

Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA

Vityata
  • 42,633
  • 8
  • 55
  • 100
0

The Sub bellow does the following

  • Determine the last used row in Worksheets("2") based on values in column A
  • Determine the last used col in Worksheets("2") based on values in row 1
  • Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
  • Loop through all used rows in Worksheets("2")
    • If the cell in col A is not empty And cell in col G is empty
      • Copy entire row to next empty row in Worksheets("Core_Cutter_List")
      • Increment next empty row for Worksheets("Core_Cutter_List")
    • Loop to the next used row in Worksheets("2")

Option Explicit

Public Sub CopyRows()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
    Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long

    Set ws1 = ThisWorkbook.Worksheets("2")
    Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")

    ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row        'last row in "2"
    ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
    ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1    'last row in "Core_Cutter"

    For i = 1 To ws1lr

        If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then

            Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
            Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))

            ws2r.Value2 = ws1r.Value2
            ws2lr = ws2lr + 1
        End If

    Next i

End Sub

My test file

Worksheets("2")

Worksheets("Core_Cutter_List")

Worksheets("Core_Cutter_List")

Worksheets("Core_Cutter_List")

paul bica
  • 10,557
  • 4
  • 23
  • 42
  • Thank you so much for your help. When I try to run the code it gives me an error saying "Compile Error: Invalid Inside Procedure" when I run the debug it brings me up to the Option Explicit section of the code. Do you know why it's bugging out? – Melnemac32 Mar 20 '18 at 18:32
  • Sure, somewhere in your module you have a Sub() defined inside another Sub(), or one sub is not closed off properly (using and "End Sub"). Not to spend your time cleaning up your current file, create a new test file with a small set of data, and the same sheet names, then add a new VBA standard module and test the code in the answer, then you may need to cleanup the module in your main file – paul bica Mar 20 '18 at 18:36
  • So I tried this, but I still got an error. I realized that I had my macro named, so I got rid of the naming function. Then I got an error that said run time error '9' script out of range, and then it highlighted Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List") – Melnemac32 Mar 20 '18 at 19:01
  • In your file it looks for a sheet named "Core_Cutter_List" and it cannot find it (make sure it's spelled exactly like that - with underscores and not spaces between the words) – paul bica Mar 20 '18 at 19:02
  • Sorry one more question... I just realized a problem that I didn't think of. There might be times where we update the macro before someone marks an order complete (which is my trigger for G being blank or not) but I don't want the order to copy over twice onto the core cutter list. Any ideas on how to have it not copy values already on that list? – Melnemac32 Mar 20 '18 at 19:21
  • Do you have any unique identifiers within one row? (what's the easiest way to determine that we already have the row copied?) – paul bica Mar 20 '18 at 19:25
  • I would say that if we did an & to combine columns A, C, and D that would show if it was unique or not. But I'd rather that not show up on the spreadsheet if possible. – Melnemac32 Mar 20 '18 at 19:31
  • Great. This question can be closed - please accept the answer if it solves the initial request, and open a new question (with this code) asking specifically about not copying duplicate rows, with the details you just provided); The next one is a bit more involved but I'll get working on it now – paul bica Mar 20 '18 at 19:35
  • Sorry, How do I accept the answer to close the question? – Melnemac32 Mar 20 '18 at 23:26
  • No problem: to mark an answer as accepted, click on the check mark beside the answer to toggle it from greyed out to green - [more details Here](https://stackoverflow.com/help/someone-answers) – paul bica Mar 21 '18 at 06:31