Loop through columns with conditional if in Excel [duplicate] - vba

Question

This question already has answers here:
Run-Time error 1004 Excel 2013
(2 answers)
Closed 6 years ago.
I'm needing to write an excel script to fill in some data. Essentially what needs to happen is the script should loop through each record and when it hits a "1" it should follow each cell with another "1" until it hits the next "1". My goal is to fill in the gaps between 1s with more 1s.
Here's what I have so far:
Dim i, j As Integer
finalrow = Cells(665, 1).End(x1up).Row
finalcol = Cells(1, 10).End(x1toleft).Column
For i = 1 To finalrow
If Cells(i, j).Value = "0" Then
For j = 1 To finalcol
Next j
Else
For j = 1 To finalcol
Next j
Cells(i, j).Value = "1"
End If
Next i
I keep getting an error when this is ran.
My data is structured like this:
0 0 1 0 0 0 1 0 0 0
1 0 0 1 0 0 0 0 0 0
0 0 0 1 0 0 1 0 0 0
0 0 0 1 1 0 0 0 0 0
Any help or advise is much appreciated.
Thanks.

Answer 1

There are a few issues with your code (particularly that FOR LOOP doesn't make much sense).
I took what you had and made comments and changed to quasi-fit what you are asking for.
Absorb:
Option Explicit 'USE THIS!!!
Sub Test()
'Dim i, j As Integer NO! "i" is Varaint and you want integer
Dim i As Integer, j As Integer 'Use this syntax for single line declaration
'Adding "Option Explicit" makes you declare these two variables
Dim finalRow As Integer
Dim finalCol As Integer
Dim oneFound As Boolean 'This will be used on the for loop
finalRow = Range("A65536").End(xlUp).Row 'Do this. I'm not sure your code works: Cells(665, 1).End(xlUp).Row 'you had x1, not "XL" (typo)
finalCol = Range("IV1").End(xlToLeft).Column ''Do this. I'm not sure your code works: Cells(1, 10).End(xlToLeft).Column 'had x1, not "XL" (typo)
oneFound = False
For i = 1 To finalRow 'You're looping through rows here, now you need to loop through columns
'REASON FOR YOUR ERROR: Variable j below is zero at this point and there is no cell (1,0).
'If Cells(i, j).Value = "0" Then
For j = 1 To finalCol
If Cells(i, j).Value = 1 And Not oneFound Then 'We found a one in a cell and we haven't started in filling ones yet
oneFound = True
ElseIf Cells(i, j).Value <> 1 And oneFound Then 'You found a one previously in the row and you want to start filling in data
Cells(i, j).Value = 1
ElseIf Cells(i, j).Value = 1 And oneFound Then 'You found a one previously in the row and you just found your next one
'Don't know what you want to do here
'Setting oneFound to false in case you want to stop filling in data
oneFound = False
Else
'All scenarioes should be covered for what you asking above.
'You could do something else here should you find the need
End If
Next j
oneFound = False 'Reinitialize for next row
Next i
End Sub

Answer 2

If all you are trying to do is replace zeros with ones, instead of looping through the data you could use search and replace functionality.
Cells.Select
Selection.Replace What:="0", Replacement:="1"

Answer 3

Sub abc()
j = 2
ActiveSheet.Range("a1").Select
ActiveSheet.Range("a65536").Select
lastrow = Selection.End(xlUp).Row
'/// column a
ActiveSheet.Range("a3:a" & lastrow).Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$A$" & lastrow).AutoFilter Field:=1, Criteria1:="="
Application.CutCopyMode = False
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet2").Select
lrow = ActiveSheet.Range("A65536").End(xlUp).Row
ActiveSheet.Range("a" & lrow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Selection.AutoFilter
'column b///////////
ActiveSheet.Range("b3:b" & lastrow).Select
Selection.AutoFilter
ActiveSheet.Range("$b$1:$b$" & lastrow).AutoFilter Field:=1, Criteria1:="="
Application.CutCopyMode = False
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet2").Select
lrow = activehseet.Range("A65536").End(xlUp).Row
ActiveSheet.Range("a" & lrow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Selection.AutoFilter
'column c////////////
ActiveSheet.Range("c3:c" & lastrow).Select
Selection.AutoFilter
ActiveSheet.Range("$c$1:$c$" & lastrow).AutoFilter Field:=1, Criteria1:="SG Plus", _
Operator:=xlOr, Criteria2:="=Select"
Application.CutCopyMode = False
Range(Selection, Selection.End(xlToRight)).Select
' Selection.Copy
' Sheets("Sheet2").Select
' lrow = activehseet.Range("A65536").End(xlUp).Row
' ActiveSheet.Range("a" & lrow).Select
' ActiveSheet.Paste
' Sheets("Sheet1").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Selection.AutoFilter
'column c again/////////////
ActiveSheet.Range("c3:c" & lastrow).Select
Selection.AutoFilter
ActiveSheet.Range("$c$1:$c$" & lastrow).AutoFilter Field:=1, Criteria1:="="
Application.CutCopyMode = False
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet2").Select
lrow = activehseet.Range("A65536").End(xlUp).Row
ActiveSheet.Range("a" & lrow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Selection.AutoFilter
'//////////////////////////// changes oct 21 end
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("a" & i).Select
If Range("a" & i).Value = "MidAmerica" Or Range("a" & i).Value = "Northeast" Or Range("a" & i).Value = "Southeast" Or _
Range("a" & i).Value = "West" Then
GoTo cont
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
Range("a" & j).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont:
Next i
'/////// column b ///////////
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("b" & i).Select
If Range("b" & i).Value = "CA" Or Range("b" & i).Value = "AZ" Then
GoTo cont2
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
Range("a" & j).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont2:
Next i
'///////////column c //////////
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("c" & i).Select
If Range("c" & i).Value = "SG" Then
GoTo cont3
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
Range("a" & j).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont3:
Next i
'//////////column l/////////////
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("l" & i).Select
If Range("l" & i).Value >= "01/01/2014" And Range("l" & i).Value <= "30/06/2014" Then
GoTo cont4
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
Range("a" & j).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont4:
Next i
'//////////column m/////////////
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("m" & i).Select
If Range("m" & i).Value >= "12/01" Or Range("m" & i).Value <= "12/05" Then
GoTo cont5
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
Range("a" & j).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont5:
Next i
'//////////column q and r/////////////
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("q" & i).Select
If Range("q" & i).Value <> " " And Range("r" & i).Value <> " " And Range("u" & i).Value <> " " _
And Range("z" & i).Value <> " " And Range("aa" & i).Value <> " " And Range("ab" & i).Value <> " " _
And Range("b" & i).Value <> " " And Range("j" & i).Value <> " " Then
GoTo cont6
Else
Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
Sheets("Sheet2").Select
Range("a" & j).Select
ActiveSheet.Paste
j = j + 1
Sheets("sheet1").Select
Selection.Delete Shift:=xlUp
End If
cont6:
Next i
End Sub

Answer 4

you could do that with the use of a formula and replace the existing values like this:
Sub Test2()
Dim iRow As Integer
Dim iDx As Integer
Dim iLastRow As Integer
Dim sConcatValues As String
Dim sFormula As String
sConcatValues = "A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J"
sFormula = "=LEFT(" & sConcatValues & ",FIND(""1""," _
& sConcatValues & ")) & REPT(""1"",FIND(""1""," _
& sConcatValues & ",FIND(""1""," _
& sConcatValues & ")+1)-1-FIND(""1""," _
& sConcatValues & ")) & MID(" _
& sConcatValues & ",FIND(""1""," _
& sConcatValues & ",FIND(""1""," _
& sConcatValues & ")+1),LEN(" _
& sConcatValues & "))"
iLastRow = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
iRow = 1
' put in the formula to fix the values
Range("L1:L" & iLastRow).Formula = sFormula
Range("L1:L" & iLastRow).Copy
Range("L1:L" & iLastRow).PasteSpecial xlPasteValues
' now copy over the new values, and clean up!
For iRow = 1 To iLastRow
For iDx = 1 To Len(Range("L" & iRow).Text)
Cells(iRow, iDx) = Mid(Range("L" & iRow).Text, iDx, 1)
Next
Next
Range("L1:L" & iLastRow).Clear
'Range("A1").Activate
End Sub
this is the formula that is used:
=LEFT(A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J,FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J)) & REPT("1",FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J,FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J)+1)-1-FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J)) & MID(A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J,FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J,FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J)+1),LEN(A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J))
basically you concatenate the cells, then do a find for the first 1, followed by the next 1, and fill in between using the REPT function
Philip

Answer 5

Including this might help as well.
http://msdn.microsoft.com/en-us/library/office/aa213567%28v=office.11%29.aspx
Cells.SpecialCells(xlCellTypeLastCell)
Instead of using
finalRow = Range("A65536")...
finalCol = Range("IV1").End(xlToLeft).Column