Consulting

Results 1 to 5 of 5

Thread: Can anybody please show me how to loop the following macro until a cell is empty

  1. #1

    Can anybody please show me how to loop the following macro until a cell is empty

    Can anybody please show me how to loop the following macro until a cell is empty in column A of Sheet("Data Sheet Copy"), thanks
    The macro code below selects & copies the first rows of data (including the header) in Sheet("Data Sheet Copy") TransposePaste in an empty row of column A in Sheet("New Sheet"). I then select Sheet("Data Sheet Copy") and delete Row 2 (the row that has been copied). I have tried several code snippets but have been unsuccessful in looping this macro until a cell is empty in column A of Sheet("Data Sheet Copy")

    Sub Copy_Row2_TransposePaste_Delete_Row2()
        Sheets("Data Sheet Copy").Select
        Range("A1:A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Sheets("NewSheet").Select
        With Sheets("NewSheet")
        lst = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & lst).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
    End With
        Sheets("Data Sheet Copy").Select
        Application.CutCopyMode = False
        Rows("2:2").Select
        Selection.Delete Shift:=xlUp
        ActiveCell.Offset(1, 0).Select
       End Sub


  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Doing only the necessary to alter your code:
    Sub Copy_Row2_TransposePaste_Delete_Row2()
    Do
      Sheets("Data Sheet Copy").Select
      Range("A1:A2").Select
      Range(Selection, Selection.End(xlToRight)).Select
      Selection.Copy
      Sheets("NewSheet").Select
      With Sheets("NewSheet")
        lst = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & lst).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      End With
      Sheets("Data Sheet Copy").Select
      Application.CutCopyMode = False
      Rows("2:2").Select
      Selection.Delete Shift:=xlUp
    Loop Until ActiveCell.Value = ""
    End Sub
    What you're doing is unpivoting the table. There are other ways to do this.
    Supply a workbook with realistic data in and I can show you several otherways…
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    Thank you very much your help. I have attached a sample workbook.
    Data Sheet.xlsm
    Quote Originally Posted by p45cal View Post
    Doing only the necessary to alter your code:
    Sub Copy_Row2_TransposePaste_Delete_Row2()
    Do
      Sheets("Data Sheet Copy").Select
      Range("A1:A2").Select
      Range(Selection, Selection.End(xlToRight)).Select
      Selection.Copy
      Sheets("NewSheet").Select
      With Sheets("NewSheet")
        lst = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & lst).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      End With
      Sheets("Data Sheet Copy").Select
      Application.CutCopyMode = False
      Rows("2:2").Select
      Selection.Delete Shift:=xlUp
    Loop Until ActiveCell.Value = ""
    End Sub
    What you're doing is unpivoting the table. There are other ways to do this.
    Supply a workbook with realistic data in and I can show you several otherways…

  4. #4
    The table of customers and food products orders. This table changes every week.
    I want to make order lists/invoices for each customer
    I have decided to try the DO loop, it works, thank you p45cal
    Please find table sample with macro attached

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    You seem to have row headers as well as column headers.
    Is this is fact the sort of thing you're looking for?:
    2021-03-07_170934.jpg
    If not, try just adding any text in cell A1 of the Data Sheet Copy sheet and run the macro. Is the result on NewSheet what you really want?
    If that isn't what you want either, add a sheet to your attached file showing us what you actually want to see on NewSheet.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •