I'm currently studying on my own vba so thanks in advance for taking the time to read this.
I've researched a lot and got stuck with a vba error regarding the variables of my formula, the code is the following:
Dim i As Long
Dim j As Long
Dim k As Integer
Dim iVal As Byte
With ActiveSheet
iVal = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
j = 2
k = -1
For i = 3 To iVal
j = j+1
k = k-1
Range("L3").Select
ActiveCell.FormulaR1C1 = "=IF(R" & i & "C5=R[" & k & "])"
'ActiveCell.FormulaR1C1 = "=+IF(R3C5=R[-2]C,R3C1,"" "")"
Selection.AutoFill Destination:=Range("L" & i & ": W" & i), Type:=xlFillDefault
This is what I'm trying to do "automatic" with the For statement
Range("L3").Select
ActiveCell.FormulaR1C1 = "=+IF(R3C5=R[-2]C,R3C1,"" "")"
Selection.AutoFill Destination:=Range("L3:W3"), Type:=xlFillDefault
Range("L4").Select
ActiveCell.FormulaR1C1 = "=+IF(R4C5=R[-3]C,R4C1,"" "")"
Selection.AutoFill Destination:=Range("L4:W4"), Type:=xlFillDefault
Range("L5").Select
ActiveCell.FormulaR1C1 = "=+IF(R5C5=R[-4]C,R5C1,"" "")"
Selection.AutoFill Destination:=Range("L5:W5"), Type:=xlFillDefault
Next
I think I'm really close but must be a minor detail I'm missing, thanks.
Try this:
Range("L" & i & ":W" & i).FormulaR1c1 = "=IF(R" & i & "C5 = R[" & k & "]C,R" & i & "C1,"" "")"
With r1c1 there is no need of autofill.
It looks to me like you just need:
Range("L3:W" & iVal).FormulaR1C1 = "=IF(RC5=R1C,RC1,"" "")"
Related
I'm trying to use a loop variable as autofilter criteria.
The loop is working fine when I put the autofilter criteria manually.
When I try to integrate my variable (i), it is not working anymore.
Column A contains a series of material numbers ranging from 1-115. One by one I need to filter them and calculate the MIN, MAX, AVERAGE,... on column C values. The range for the formulas is the number of rows filtered. This part is working fine.
As I don't want to repeat this code 115 times, I want to use a loop. The loop itself is working fine.
The autofilter should use the value for I (loop counter) in the selection criteria.
This is not working.
Dim rijen As Integer
Dim start As Integer
Dim filterA As String
Dim filterB As String
Dim aantal As Integer
Dim i As Integer
range("A2").Select
Selection.End(xlDown).Select
aantal = ActiveCell.Value
i = 1
Do Until i > aantal
range("A2").Select
' THIS IS THE PART THAT IS NOT WORKING
ActiveSheet.range("$A$2:$H$1045876").AutoFilter Field:=1, Criteria1:=" & i & "
'THIS IS WORKING FINE AGAIN
ActiveSheet.AutoFilter.range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, A).Select
start = ActiveCell.Row
range("A2").Select
Selection.Offset(1, 0).Select
rijen = range(Selection, Selection.End(xlDown)).Rows.Count + start - 1
filterA = ("C" & start)
filterB = ("C" & rijen)
range("D2").Select
Selection.Offset(1, 0).Select
ActiveCell.Formula = "=MIN(" & filterA & ":" & filterB & ")"
range("E2").Select
Selection.Offset(1, 0).Select
ActiveCell.Formula = "=MAX(" & filterA & ":" & filterB & ")"
range("F2").Select
Selection.Offset(1, 0).Select
ActiveCell.Formula = "=GEMIDDELDE(" & filterA & ":" & filterB & ")"
range("G2").Select
Selection.Offset(1, 0).Select
ActiveCell.Formula = "=STDEVA(" & filterA & ":" & filterB & ")"
range("H2").Select
Selection.Offset(1, 0).Select
ActiveCell.Formula = "=MIN(RC[-3],(RC[-2]+RC[-1]))"
ActiveSheet.range("$A$2:$H$1045876").AutoFilter Field:=1
i = i + 1
Criteria1:=" & i & "
This is wrapped in quotes, so it is taking it as a literal string value of "& i &". Just remove the quotes and ampersands.
Criteria1:= i
You are using .Select way too much. This question should be of use to you.
Any particular reason you are using VBA to insert all of these formulas rather than, say, an Excel table?
I have a data issue that has been perplexing me for a few weeks now.
Goal:
- Sum set range into new reference cell. Perform this for 8 different ranges spanning 42 columns. This needs to be performed on a row by row basis so each entry has their appropriate numbers.
- Columns L:S should only have a value if the SUM range itself had any values. No false 0's.
Issues:
- The SUM Function works, but it is returning a 0 in situations when there were no values to Sum. This is an issue as 0 is a valid value, and the extra 0's throw off averages of those who actually have values.
- SUMIFS is returning TRUE instead of a value (I use SUMIFS with 1 criteria as it is easier for me to understand, don't focus on that bit as it did the same thing when I had it in the SUMIF formula).
Here is my VBA in it's entirety:
Sub BE_Candidate_Flow_Time()
'
' BE_Candidate_Flow_Time Macro
'
Dim StartCell As Range
Dim RangeName As String
Dim myValue As Variant
Set StartCell = Range("A1")
myValue = InputBox("Enter Date: YY-MMM")
StartCell.CurrentRegion.Select
RangeName = "Dataset"
Dim LRow As Long
Dim lCol As Long
LRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Columns("J:Q").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").FormulaR1C1 = "Application ID"
Range("B1").FormulaR1C1 = "Timeframe"
Range("K1").FormulaR1C1 = "Job Code"
Range("L1").FormulaR1C1 = "Time to Complete the Assessment"
Range("M1").FormulaR1C1 = "Applied/Assessed and Ready for Review"
Range("N1").FormulaR1C1 = "Time being Reviewed and Interviewed"
Range("O1").FormulaR1C1 = "Time to Accept the Offer"
Range("P1").FormulaR1C1 = "Consent to Pre-Hire Screenings"
Range("Q1").FormulaR1C1 = "Run the Pre-Hire Screenings"
Range("R1").FormulaR1C1 = "Waiting to be sent to Onboard"
Range("S1").FormulaR1C1 = "In Onboard"
Range("A2", "A" & LRow).FormulaR1C1 = "=CONCATENATE(RC[2],RC[5])"
Range("B2", "B" & LRow).Value = myValue
Columns("T:BI").NumberFormat = "0.00"
Range("L2", "L" & LRow).FormulaR1C1 = "=SUMIFS({RC[9];RC[13]},{RC[9];RC[13]}," <> ")"
Range("M2", "M" & LRow).FormulaR1C1 = "=SUMIFS({RC[7];RC[9]:RC[11];RC[13]:RC[16]},{RC[7];RC[9]:RC[11];RC[13]:RC[16]}," <> ")"
Range("N2", "N" & LRow).FormulaR1C1 = "=SUMIFS({RC[16]:RC[27]},{RC[16]:RC[27]}," <> ")"
Range("O2", "O" & LRow).FormulaR1C1 = "=SUMIFS({RC[27]:RC[31];RC[33]:RC[34]},{RC[27]:RC[31];RC[33]:RC[34]}," <> ")"
Range("P2", "P" & LRow).FormulaR1C1 = "=SUMIFS({RC[34]},{RC[34]}," <> ")"
Range("Q2", "Q" & LRow).FormulaR1C1 = "=SUMIFS({RC[35]:RC[40]},{RC[35]:RC[40]}," <> ")"
Range("R2", "R" & LRow).FormulaR1C1 = "=SUMIFS({RC[40]:RC[41]},{RC[40]:RC[41]}," <> ")"
Range("S2", "S" & LRow).FormulaR1C1 = "=SUMIFS({RC[41]:RC[42]},{RC[41]:RC[42]}," <> ")"
Range("K1", "K" & LRow).AutoFilter 1, ""
Range("K2", "K" & LRow).FormulaR1C1 = "=RC[-1]"
[K1].AutoFilter
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("J:J,T:BI").Delete Shift:=xlToLeft
Range("A1").Select
End Sub
You could add a if to the formula directly.
Somthing like
=IF(
count({RC[7];RC[9]:RC[11];RC[13]:RC[16]})>0;
SUM({RC[7];RC[9]:RC[11];RC[13]:RC[16]};
""
)
I have Autofill Method Out of Range Class Error from some reason and I can't find why. I have lots of formulas in my code and I use it a lot and it is stops my code every time. this is the relavant part of my sub:
'U means union, M means main
'Advanced filter for visual worksheet
UnionWB.Worksheets("Union").ShowAllData
Dim ULR As Long, ULC As Long, MLR As Long
ULR = Cells(Rows.Count, "A").End(xlUp).Row
ULC = Cells(1, Columns.Count).End(xlToLeft).Column
With MainWB.Worksheets(sheet1)
MLR = .Cells(Rows.Count, "A").End(xlUp).Row
End With
MainWB.Worksheets("aheet2").Columns("A:Z").Clear
UnionWB.Worksheets("Union").Range(Cells(1, 1), Cells(ULR, ULC)).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=MainWB.Worksheets("sheet1").Range("A1", "A" & MLR), Unique:=False
UnionWB.Worksheets("Union").Activate
Range("A1", "Y" & ULR).Select
Selection.Copy
MainWB.Worksheets("sheet2").Activate
Range("A1").PasteSpecial xlPasteValues
Range("AB2").Select
Selection.AutoFill Destination:=Range("AB2", "AB" & MLR)
If MLR > 2 Then
With MainWB.Worksheets("sheet1).Range("N2")
ActiveCell.FormulaR1C1 = _
"=IF(ISNUMBER(SEARCH(""sheet2"",RC[-9])),""yes"",""no"")"
Selection.AutoFill Destination:=Range("N2", "N" & MLR)
End With
End If
Selection.AutoFill Destination:=Range("AB2", "AB" & MLR)
Selection.AutoFill Destination:=Range("N2", "N" & MLR)
Change the 2 lines below:
Range("AB2").Select
Selection.AutoFill Destination:=Range("AB2", "AB" & MLR)
To:
Range("AB2").AutoFill Destination:=Range("AB2:AB" & MLR), Type:=xlFillDefault
The below code seeks to pull the value from a cell in the the 'Input' sheet, and then display it in the 'Output' sheet. It then shows the difference between the last value recorded and expresses the figure as a percentage.
When I run this code with the Output sheet active it works. However, when I run it from the output sheet it doesn't. Instead, it displays the value I wish to copy in column F in the input sheet and displays the difference and percentage difference in the wrong cells in the Output sheet.
It looks correctly referenced to me, but it obviously isn't. Thoughts on how to correct?
I appreciate that the code could be tidier - i'm very new to this.
Sub Button1_Click()
Dim LastRow As Long
Dim RecentRow As Long
With Sheets("Output")
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
RecentRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
Range("F" & LastRow).Select
ActiveCell.Offset(1, 0).Formula = "=Input!B4"
ActiveCell.Offset(1, 0).Copy
ActiveCell.Offset(1, 0).PasteSpecial (xlValues)
End With
ActiveCell.Offset(0, 1).Formula = "=(F" & RecentRow & "-F" & LastRow & ")"
ActiveCell.Offset(0, 2).Formula = "=((F" & RecentRow & "/F" & LastRow & ")-1)"
End Sub
Thanks.
The below code should fix your issue - it's because your Range("F" & LastRow).Select did not have a period before Range.
Sub Button1_Click()
Dim LastRow As Long
Dim RecentRow As Long
With Sheets("Output")
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
RecentRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
With .Range("F" & LastRow)
.Offset(1, 0).Formula = "=Input!B4"
.Offset(1, 0).Copy
.Offset(1, 0).PasteSpecial (xlValues)
.Offset(0, 1).Formula = "=(F" & RecentRow & "-F" & LastRow & ")"
.Offset(0, 2).Formula = "=((F" & RecentRow & "/F" & LastRow & ")-1)"
End With
End With
End Sub
Furthermore, you can gain a bit more efficiency in your code with the below:
Sub Button1_Click()
Dim LastRow As Long
With ThisWorkbook.Sheets("Output") 'Allow for code to work even if in another workbook.
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
With .Range("F" & LastRow)
.Offset(1, 0).Value2 = ThisWorkbook.Sheets("Input").Range("B4").Value2
.Offset(0, 1).Formula = "=(F" & LastRow + 1 & "-F" & LastRow & ")"
.Offset(0, 2).Formula = "=((F" & LastRow + 1 & "/F" & LastRow & ")-1)"
End With
End With
End Sub
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.
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
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"
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
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
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