Results 1 to 2 of 2
  1. #1
    Lounger
    Join Date
    May 2012
    Posts
    25
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Skip if there is a blank in the range move to next row

    I have created a workbook that is the template for the reports that are run....

    in a sheet called run i have a list of store codes that require a report to be produced.

    in my run sheet

    there are 1-30 stores for each store there are store consultants (StC) and there are service consultant (SerC).

    ex.

    Store 1235
    StC 0365
    StC 0366
    StC 0368

    SerC 1359
    SerC 1358
    SerC 1354

    for the 30 stores there will be a different number of store consultants (StC) and there are service consultant (SerC).

    So from row 1 is the Store Code and row 2 -10 is the store consultants and rows 11-20 are the service consultants,

    My problem is that currently becuase of the different numbers of store consultant and service consultant there are blank cells between store consultant and service consultant codes, I need my code to skip through the blanks if any and go to the next row, (so for the example above I need to skip 6 rows and move to row 11)

    PLEASE HELP!!

    this is my code:

    Set ws1 = Sheets("Run") 'define shortcut for specified sheet

    Set myRange = Worksheets("Run").Range("A1:XFD1")
    countNonBlank = Application.WorksheetFunction.CountA(myRange)

    zLastCol = countNonBlank 'e.g. 140, = number of Dealers
    Set ws2 = Sheets("DealerTableService") 'define shortcut for specified sheet
    Set ws3 = Sheets("AdvisorTableService") 'define shortcut for specified sheet
    Set ws4 = Sheets("TechnicianTableService")

    '************************************************* *****
    'DEFINE FOLDER LOCATION FOR SAVED REPORTS..
    '************************************************* *****

    If ActiveWorkbook.Path = "C:\Users\Mizpah\Documents\Shekira\Store" Then
    strLoc = "C:\Users\Mizpah\Documents\Shekira\Store\Repor ts\"
    Else
    strLoc = "C:\Users\Mizpah\Documents\Shekira\Store\Repor ts\"
    End If

    '************************************************* *****
    'PROCESS EACH DEALER IN ROW 1..
    '************************************************* *****
    For MyCol = 1 To zLastCol 'process

    zStoreCode = ws1.Cells(1, MyCol).Value 'fetch current code
    [StoreCode] = zStoreCode 'place current code into cell F68

    Set wbMaster = ActiveWorkbook 'set the active workbook as the master product advisor workbook

    Set wbReport = Workbooks.Add(xlWBATWorksheet) 'create new workbook with single worksheet

    wbReport.Colors = wbMaster.Colors 'copies same colors as Master workbook

    '************************************************* *****
    'COPY Store REPORT.
    '************************************************* *****

    wbMaster.Worksheets("Store - Report").Copy After:=wbReport.Worksheets(wbReport.Worksheets.Cou nt) 'copies the pages

    Cells.Copy 'COPY ALL THE CELLS IN A WORKBOOK
    Cells.PasteSpecial xlPasteValues 'so it breaks the links

    '************************************************* *****
    'PROCESS EACH Store Consultant
    '************************************************* *****
    lr = ws1.Cells.CurrentRegion.Rows.Count 'last row
    zCount = lr - 1

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~
    For MyRow = 2 To 10 'process each Store Consultant

    ThisWorkbook.Activate 'switch back to THIS workbook

    [StoreConsultantCode] = ws1.Cells(MyRow, MyCol).Value 'place current


    wbMaster.Worksheets("StoreConsultant - Report").Copy After:=wbReport.Worksheets(wbReport.Worksheets.Cou nt) 'copies the pages

    Cells.Copy 'copy all cells on worksheet to clipboard..
    Cells.PasteSpecial xlPasteValues '..and paste back as values (breaks the links)


    If [StoreConsultantCode] = "" Then

    `if StoreConsultantCode is blank move to the next row

    End If

    Cells.Copy 'copy all cells on worksheet to clipboard..
    Cells.PasteSpecial xlPasteValues '..and paste back as values (breaks the links)

    Next MyRow
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~

    '************************************************* *****
    'PROCESS EACH Service Consultant
    '************************************************* *****
    lr = ws1.Cells.CurrentRegion.Rows.Count 'last row for the Zone
    zCount = lr - 1 'number of Zone

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~
    For MyRow = 11 To 20 'process each Service Consultant

    ThisWorkbook.Activate 'switch back to THIS workbook

    [ServiceConsultant] = ws1.Cells(MyRow, MyCol).Value 'place current Service Consultant code in F136

    wbMaster.Worksheets("ServiceConsultant - Report").Copy After:=wbReport.Worksheets(wbReport.Worksheets.Cou nt) 'copies the pages


    Cells.Copy 'copy all cells on worksheet to clipboard..
    Cells.PasteSpecial xlPasteValues '..and paste back as values (breaks the links)

    Next MyRow 'process next Service Consultant

    Report Saves

    wbReport.Close True

    Next MyCol

    PLEASE HELP!!!!

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Could you attach an example file (remove any proprietary information) and explain exactly what you want the code to do. It would be helpful to show a BEFORE sheet and an AFTER file so we can better understand

    Steve

Posting Permissions

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