Need to loop through column AI and if cell is not empty then look look in column W and move number in next column

user_17647959 0
Viewed 124

enter image description hereHERE IS A NEW IMAGE HOPEFULLY SHOWING WHAT HAS TO MOVE AND WHERE'Here is a sample of some code I have been trying.

sub
For Each cel In Range("W2:W1000")
    If cel.Value = "Credit Adj W/O To Collection" AND
    Range("AI2:AI1000").Cells.Value > ""  THEN
    cel.Offset(0,-9).value =
end sub

Basically I need to look in column W for a specific text and if it is found move the number in the next column, col X over to column Y in the same row as the data in column AI, but in column Y. My issue is the amount of rows it has to move up is different based on where the data is in column AI. See screenshot

Screeshot

All of you have been a great help but it is still not moving any numbers. I added another screenshot. I need to look for the text in blue, if found move the amount in column X two columns right and up to the row that has a value in column AI. That gap could be different for each entry, as shown in the screen shot. could be 2 or 4 or 5, just depends on Column AI. Also first entry may not always start in the same row as it does here. The spot in column W and AI may be different throughout the spreadsheet. Hope this helps define my purpose a little.

Everyone has had great ideas but still not working, logic in answers makes sense but it is not grabbing any of the data much less move it. Not sure what is up.

vba excel
2 Answers

Try this:

Sub tester()
    
    Dim c As Range, ws As Worksheet, rw As Range
    Set ws = ActiveSheet 'always use an explicit sheet reference
    
    For Each c In ws.Range("W2:W1000").Cells
        Set rw = c.EntireRow  'the whole row for the cell
        If c.Value = "Credit Adj W/O To Collection" And _
                      IsNumeric(rw.Columns("X").Value) Then
            'copy the value to Col Y in the row above which has a value in Col AI
            ws.Cells(rw.Columns("AI").End(xlUp).Row, "Y").Value = rw.Columns("X").Value
            rw.Columns("X").ClearContents ' clear the "X" value
        
        End If
    Next c
End Sub
user_4788840

A Tricky Column Update

  1. Loop (r = r + 1) from the first row to the last row (the latter calculated in column W).
  2. When column AI is not blank, write the row number to a variable (rFound).
  3. Continue looping (r = r + 1). When column W is equal to the string Credit Adj W/O To Collection, write the value in column X of the current row to column Y of the row kept in the variable (rFound).
  4. Continue looping (r = r + 1) by alternating between steps 2. and 3. until the last row.
Option Explicit

Sub UpdateInsAmt()
    
    Const wsName As String = "Sheet1"
    Const rStart As Long = 4
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    Dim rLast As Long: rLast = ws.Cells(ws.Rows.Count, "W").End(xlUp).Row
    Dim r As Long: r = rStart
    Dim rFound As Long
    
    Do
        If Len(CStr(ws.Cells(r, "AI").Value)) > 0 Then ' is not blank
            rFound = r
            r = r + 1 ' it can't be in the same row
            Do
                If StrComp(CStr(ws.Cells(r, "W").Value), _
                        "Credit Adj W/O To Collection", vbTextCompare) = 0 Then
                    ws.Cells(rFound, "Y").Value = ws.Cells(r, "X").Value
                    Exit Do ' value found and written so stop looping ...***
                'Else ' value not found ...
                End If
                r = r + 1 ' ... so incremenet row
            Loop Until r > rLast
        ' Else ' is blank ...
        End If
        r = r + 1 ' ... so increment row, ...*** and increment row
    Loop Until r > rLast
    
End Sub
user_98140690
Related