none
macro to loop column RRS feed

  • Question

  • hi,

    Question : I need help on below macro to loop column.

    Process : i have two sheets one is Calendar and second is Task

    Calendar sheet is as shown below (example: - A1:C1 is merged and named as "January" A2 all dates, B2 all days, C2 will be filled from Task Sheet, column D is blank, E1:G1 is merged and named as "February" E2 all dates, F2 all days and so on...

    January February March
    1 Mo   1 Th   1 Th  
    2 Tu   2 Fr   2 Fr  
    3 We   3 Sa   3 Sa  
    4 Th   4 Su   4 Su  
    5 Fr   5 Mo   5 Mo  
    6 Sa   6 Tu   6 Tu  
    7 Su   7 We   7 We  
    8 Mo   8 Th   8 Th  

    Task sheet is as shown below ( example: Column "A" contains all dates and column "B" contains all Names

    working Day Name
    9 xyc
    11 rte

    Requirement: -  First the macro should check in Task Sheet column "A" and pick the date value, then go calendar sheet and loop column "A" that is for the month of January and if same date is found then copy column "B" value of Task sheet and paste to column "D" of calendar sheet, in the similar way it should loop all the rows (and my below macro its doing 50%)

    after the January month is completed the macro should loop through the February column and so on until column is found empty.

    the calendar sheet will have more than one year of calendar date and months for example Jan-2017 to Dec-2017 after that the column continues to have Jan-2018 to Dec-2018, so my macro column loop should end when it find blank column (after every month there is one column left blank so the macro should not stop by reading that column it should stop if activecell.offset fouth column is blank)

     if the day is "Sa" (Saturday) or "Su" (Sunday) in calendar sheet then the macro should copy the task (value of Column "B" from Task sheet)to next working day that is Mo,Tu, We,Th,Fr

    Sub task()
    Dim x, y

    Sheets("Task").Activate

    For Each x In Sheets("Task").Range(Range("A2"), Range("A2").End(xlDown))
    a = x.Select
    xid = x.Value

    Sheets("Calendar").Activate
    For Each y In Sheets("Calendar").Range(Range("A2"), Range("A2").End(xlDown))
    c = y.Select
    yid = y.Value

    If xid = yid Then
    Sheets("Task").Select
    ActiveCell.Offset(0, 1).Select
    d = ActiveCell.Value
    Sheets("Calendar").Select
    ActiveCell.Offset(0, 2).Select
    ActiveCell.Value = d
    End If

    Next y

    Sheets("Task").Select
    ActiveCell.Offset(0, -1).Select

    Next x

    End Sub



    Saturday, September 16, 2017 6:22 PM

Answers

  • Hi 5Ant,

    You could iterate through rows in task sheet and then iterate through columns in calendar sheet and then iterate through rows in calendar sheet to confirm which cell to enter name.

    Here is the macro example.

    Sub Test()
    
    Dim taskSheet As Worksheet
    
    Dim calSheet As Worksheet
    
    Dim taskLastRowIndex, calLastRowIndex, calLastColumnIndex As Integer
    
    Dim taskWorkDay, calWorkDay As String
    
    Dim searchRng As Range
    
    Dim CheckString As String
    
    Dim cel As Range
    
    CheckString = "MoTuWeThFr" 'to check if day is workday
    
    Set taskSheet = ActiveWorkbook.Sheets("Task")
    
    Set calSheet = ActiveWorkbook.Sheets("Calendar")
    
    calLastColumnIndex = calSheet.Cells(1, calSheet.Columns.Count).End(xlToLeft).Column
    
    taskLastRowIndex = taskSheet.Cells(taskSheet.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To taskLastRowIndex 'loop rows in task sheet
    
    taskWorkDay = taskSheet.Cells(i, 1)
    
    For j = 1 To calLastColumnIndex Step 4 'loop columns in calendar
    
    calLastRowIndex = calSheet.Cells(calSheet.Rows.Count, j).End(xlUp).Row
    
    Set searchRng = calSheet.Range(calSheet.Cells(2, j), calSheet.Cells(calLastRowIndex, j)) 'confirm range to search day
    
    For Each cel In searchRng 'loop cell in search range
    
    If cel.Value = taskWorkDay Then
    
    calWorkDay = cel.Offset(0, 1)
    
    Dim offsetCount As Integer
    
    offsetCount = 0
    
    'confirm which cell to enter name(skip Sa,Sun)
    
    While Len(calWorkDay) > 0
    
    If InStr(CheckString, calWorkDay) > 0 Then
    
    cel.Offset(offsetCount, 3) = taskSheet.Cells(i, 2)
    
    calWorkDay = ""
    
    Else
    
    offsetCount = offsetCount + 1
    
    calWorkDay = cel.Offset(offsetCount, 1)
    
    End If
    
    Wend
    
    End If
    
    Next cel
    
    Next j
    
    Next i
    
    End Sub

    If the macro could not work for you, sharing a simply excel file could help us reproduce your issue efficiently.

    Thanks for understanding.

    Best Regards,

    Terry

    • Marked as answer by 5Ant Tuesday, October 10, 2017 4:21 PM
    Tuesday, September 19, 2017 9:35 AM

All replies

  • Hi,

    This is the forum to discuss questions and feedback for Microsoft Excel features, I'll move your question to the MSDN forum for Excel

    https://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Regards,
    Emi Zhang
    TechNet Community Support

    Please remember to mark the replies as answers if they helped.
    If you have feedback for TechNet Subscriber Support, contact tnmff@microsoft.com.

    Monday, September 18, 2017 1:51 AM
  • Hi 5Ant,

    You could iterate through rows in task sheet and then iterate through columns in calendar sheet and then iterate through rows in calendar sheet to confirm which cell to enter name.

    Here is the macro example.

    Sub Test()
    
    Dim taskSheet As Worksheet
    
    Dim calSheet As Worksheet
    
    Dim taskLastRowIndex, calLastRowIndex, calLastColumnIndex As Integer
    
    Dim taskWorkDay, calWorkDay As String
    
    Dim searchRng As Range
    
    Dim CheckString As String
    
    Dim cel As Range
    
    CheckString = "MoTuWeThFr" 'to check if day is workday
    
    Set taskSheet = ActiveWorkbook.Sheets("Task")
    
    Set calSheet = ActiveWorkbook.Sheets("Calendar")
    
    calLastColumnIndex = calSheet.Cells(1, calSheet.Columns.Count).End(xlToLeft).Column
    
    taskLastRowIndex = taskSheet.Cells(taskSheet.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To taskLastRowIndex 'loop rows in task sheet
    
    taskWorkDay = taskSheet.Cells(i, 1)
    
    For j = 1 To calLastColumnIndex Step 4 'loop columns in calendar
    
    calLastRowIndex = calSheet.Cells(calSheet.Rows.Count, j).End(xlUp).Row
    
    Set searchRng = calSheet.Range(calSheet.Cells(2, j), calSheet.Cells(calLastRowIndex, j)) 'confirm range to search day
    
    For Each cel In searchRng 'loop cell in search range
    
    If cel.Value = taskWorkDay Then
    
    calWorkDay = cel.Offset(0, 1)
    
    Dim offsetCount As Integer
    
    offsetCount = 0
    
    'confirm which cell to enter name(skip Sa,Sun)
    
    While Len(calWorkDay) > 0
    
    If InStr(CheckString, calWorkDay) > 0 Then
    
    cel.Offset(offsetCount, 3) = taskSheet.Cells(i, 2)
    
    calWorkDay = ""
    
    Else
    
    offsetCount = offsetCount + 1
    
    calWorkDay = cel.Offset(offsetCount, 1)
    
    End If
    
    Wend
    
    End If
    
    Next cel
    
    Next j
    
    Next i
    
    End Sub

    If the macro could not work for you, sharing a simply excel file could help us reproduce your issue efficiently.

    Thanks for understanding.

    Best Regards,

    Terry

    • Marked as answer by 5Ant Tuesday, October 10, 2017 4:21 PM
    Tuesday, September 19, 2017 9:35 AM