Excel VBA SUMIF Super slow code - excel

I have SUMIF running really really slow. My data has 14,800 Rows and 39 Columns.
I do the following:
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
EDITED TO ADD more potentially relevant code that may be interacting with the SUMIF command
It may be relevant to the speed issue so I'll mention it. I get the user to open a file from wherever they may have stored the report. The file then stays open. Maybe that is a problem. I don't know if it should be some other way.. like I close it but keep the address in mind or something??
FilterType = "Text Files (*.txt),*.txt," & "Comma Separated Files (*.csv),*.csv," & "ASCII Files (*.asc),*.asc," & "All Files (*.*),*.*"
FilterIndex = 4
Title = "File to be Selected"
File_path = Application.GetOpenFilename(FileFilter:=FilterType, FilterIndex:=FilterIndex, Title:=Title)
If File_path = "" Then
MsgBox "No file was selected."
Exit Sub
End If
Set wbSource = Workbooks.Open(File_path)
Original_Name = ActiveWorkbook.Name
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
Set wb1 = ActiveWorkbook
Set ws1 = wb1.Worksheets("Sheet1")
With ws1
FinalColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
FinalRow = .Range("B" & .Rows.Count).End(xlUp).Row
For j = 1 To FinalColumn
If .Cells(1, j).Value = "Effec.Date" Then
Effective_Date_Column = j
ElseIf .Cells(1, j).Value = "FolderId" Then
FolderId_column = j
ElseIf .Cells(1, j).Value = "FolderNotional" Then
FolderNotional_column = j
End If
Next j
'range_Total_Folder_Fixed = .Cells(2, Total_Folder_Column).Address & ":" & .Cells(FinalRow, Total_Folder_Column).Address
range_FolderId_Fixed = .Cells(2, FolderId_column).Address & ":" & .Cells(FinalRow, FolderId_column).Address
range_FolderId_Cell = .Cells(2, FolderId_column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
range_FolderNotional_Fixed = .Cells(2, FolderNotional_column).Address & ":" & .Cells(FinalRow, FolderNotional_column).Address
Everything runs in 8-10 seconds until we come to the lie below. Now the total time jumps to a 150 seconds.
.Range(range_Total_Folder_Fixed).Formula = "=SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_FolderNotional_Fixed & ")"
Am I doing something wrong? Is there a better (more efficient) way to write a general formula?
EDIT: Code generated Raw Formula
Some of the excel worksheet functions in my code:
.Range(range_Isnumber).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)<> ""IB"")*1"
.Range(range_Is_IB).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)= ""IB"")*1"
.Range(range_Exceptions).Formula = "=(SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_Isnumber_fixed & ")= COUNTIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "))*1+(SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_Is_IB_fixed & ")= COUNTIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "))*1 "
.Range("C13").FormulaR1C1 = "=SUM(IF(FREQUENCY(MATCH([SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,[SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,0),MATCH([SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,[SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,0))>0,1))"
So Stuff like
Range("I2")=SUMIF($H$2:$H$5,H2,$G$2:$G$5)
Where the data could be like
RowG RowH RowI
Alice 1 4
Alice 3 4
Bob 9 17
Bob 8 17
Dan 2 2
EDIT2 : Implementing Sam's solution, I am getting errors:
Set range_FolderId_Fixed = .Range(.Cells(2, FolderId_column), .Cells(FinalRow, FolderId_column))
Set range_FolderId_Cell = .Range(.Cells(2, FolderId_column),.Cells(FinalRow, FolderId_column))
Set range_FolderNotional_Fixed = .Range(.Cells(2, FolderNotional_column), .Cells(FinalRow, FolderNotional_column))
Set range_Total_Folder_Fixed = .Range(.Cells(2, Total_Folder_Column), .Cells(FinalRow, Total_Folder_Column))
.Range(range_Total_Folder_Fixed).Value = SumIf_func(range_FolderId_Fixed, range_FolderId_Cell, range_FolderNotional_Fixed)
I am getting a type application defined or object defined error in the line below.
.Range(range_Total_Folder_Fixed).Value = SumIf_func(range_FolderId_Fixed, range_FolderId_Cell, range_FolderNotional_Fixed)
I have no idea what to do next.

Ok this is what I came up with
Public Function SumIf_func(rng As Range, _
criteria As Range, _
sumRange As Range) As Variant()
Dim rngArr() As Variant
Dim sumArr() As Variant
Dim criteriaArr() As Variant
Dim returnArr() As Variant
Dim temp As Double
rngArr = rng.Value2
sumArr = sumRange.Value2
criteriaArr = criteria.Value2
If UBound(sumArr) <> UBound(rngArr) Then _
Err.Raise 12345, "SumIf_func", "Sum range and check range should be the same size"
If UBound(sumArr, 2) <> 1 Or UBound(rngArr, 2) <> 1 Then _
Err.Raise 12346, "SumIf_func", "Sum range and check range should be a single column"
ReDim returnArr(1 To UBound(criteriaArr), 1 To 1)
For c = LBound(criteriaArr) To UBound(criteriaArr)
returnArr(c, 1) = Application.WorksheetFunction.SumIf(rng, criteriaArr(c, 1), sumRange)
Next c
SumIf_func = returnArr
End Function
This function takes in three ranges:
The range to check
The range where the criteria are
The range where the values to sum are
The range to check and the sum range should both be the same length and only be 1 column across.
The array that is returned will be the same size as the criteria array..
Here is an example of usage:
Public Sub test_SumIf()
Dim ws As Worksheet
Set ws = Sheet1
Dim rng As Range, sumRng As Range, criteria As Range
Set rng = ws.Range("A1:A100")
Set sumRng = ws.Range("B1:B100")
Set criteria = ws.Range("C1:C10")
ws.Range("D1:D10").Value = SumIf_func(rng, criteria, sumRng)
End Sub

Related

VBA, Storing filtered values in array

My code filters out blanks and 0 records but my array is getting all values.
How can I just take into account the records filtered? Is this the best way I can do this?
Sub FilterAndCopy()
Dim LastRow As Long
Dim Arr As Variant
With Worksheets("BusinessDetails")
.Range("$A5:$AJ5").AutoFilter field:=33, Criteria1:="<>", Criteria2:="<>0", Criteria2:="<>-0"
LastRow = .Range("AG" & .Rows.Count).End(xlUp).Row
Arr = Range("AG8:AG" & LastRow)
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
Debug.Print Arr(R, C)
Next C
Next R
Dim Destination As Range
Set Destination = Sheets(2).Range("D10")
Set Destination = Destination.Resize(UBound(Arr), 1)
Destination.Value = Application.Transpose(Arr)
Sheets(1).ShowAllData
End With
End Sub
Updated code:
Sub FilterAndCopy()
Dim LastRow As Long
Dim Arr As Variant
With Worksheets("BusinessDetails")
.Range("$A5:$AJ5").AutoFilter field:=33, Criteria1:="<>", Criteria2:="<>0", Criteria2:="<>-0"
LastRow = .Range("AG" & .Rows.Count).End(xlUp).Row
Set rFiltered = Range("A5:AJ" & LastRow).SpecialCells(xlCellTypeVisible)
ReDim Arr(1 To rFiltered.Areas.Count)
I = 0
For Each V In rFiltered.Areas
I = I + 1
Arr(I) = V
Next V
rFiltered.Copy Sheets("Step 4").Range("D10")
End With
End Sub
When you filter a range, you are left with different Areas.
So your choices are to read one cell at a time into the array, or one area at a time, as an array, into the Parent array.
For example, (data is in A1:C9 and the filtering is done on column A)
With Worksheets("Sheet1")
.Range("$A1:$C9").AutoFilter field:=1, Criteria1:="<>", Criteria2:="<>0"
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rFiltered = Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible)
ReDim Arr(1 To rFiltered.Areas.Count)
I = 0
For Each V In rFiltered.Areas
I = I + 1
Arr(I) = V
Next V
Arr will now be an array of arrays, containing only the filtered cells.
Note
If all you want to do is copy the filtered range, then:
rFiltered.Copy Sheets("sheet2").Range("D10")
Note2
If you are always going to copy, you could then put that data into the array with something like (not tested):
arr = Sheets("sheet2").Range("D10").CurrentRegion
A possibility without the use of AutoFilter and looping:
(when you want to do more then only copying your filtered range)
Sub FilterAndCopyWithoutAutoFilter()
Dim rng As Range, adr As String, Fir As Long, y As Variant
With Worksheets("BusinessDetails")
Set rng = .Range("AG8:AG" & .Range("AG" & .Rows.Count).End(xlUp).Row)
adr = .Name & "!" & rng.Address
Fir = 7 'one less of first row number of your range
With Application
y = .Index(rng, .Transpose(Filter(.Transpose(.Evaluate("if(isnontext(" & adr & "),if(--" & adr & "<>0, row(" & adr & ")-" & Fir & ", ""##"" ),""##"")")), "##", False)), 1)
'or shorter when you want to include text values as well
'y = .Index(rng, .Transpose(Filter(.Transpose(.Evaluate("if(" _
& adr & "<>0, row(" & adr & ")-" & Fir & ", ""##"" )")), "##", False)), 1)
End With
End With
Sheets(2).Range("D10").Resize(UBound(y)).Value = y
End Sub

Making a dynamic selector excel

I have some a macro that assigns cataogories to various rows based on keywords.
This works well however is heavy on the machine as it is using the whole column.
How can I set it so that It will just search for these words until the last entry in column A:A?
Sub Categorise()
Sheets("Data").Range("I:I") = "=IF(OR(ISNUMBER(SEARCH(""*chair fault*"",B:B)),ISNUMBER(SEARCH(""*Chair noise*"",B:B))), ""Seating"", """")"
Sheets("Data").Range("L:L") = "=IF(OR(ISNUMBER(SEARCH(""*Arm fail*"",B:B)),ISNUMBER(SEARCH(""*Arm inhibition*"",B:B)),ISNUMBER(SEARCH(""*Gap in Arm*"",B:B)),ISNUMBER(SEARCH(""*No Arms*"",B:B)),ISNUMBER(SEARCH(""*All Arms*"",B:B))), ""Angles"", """")"
Sheets("Data").Range("M:M") = "=IF(OR(ISNUMBER(SEARCH(""*Couch*"",B:B)),ISNUMBER(SEARCH(""*Heating*"",B:B))), ""Comfort"", """")"
Sheets("Data").Range("J:J") = "=IF(OR(ISNUMBER(SEARCH(""*UDCD*"",B:B)),ISNUMBER(SEARCH(""*HDD flats*"",B:B)),ISNUMBER(SEARCH(""*HDD runner*"",B:B))), ""Runners"", """")"
Sheets("Data").Range("K:K") = "=IF(ISNUMBER(SEARCH(""*Cabbies*"",B:B)),""Cabbies four"","""")"
Sheets("Data").Range("N:N") = "=IF(ISNUMBER(SEARCH(""*Braker*"",B:B)),""Elec"","""")"
Sheets("Data").Range("O:O") = "=IF(OR(ISNUMBER(SEARCH(""*Camera*"",B:B)),ISNUMBER(SEARCH(""*chough*"",B:B)),ISNUMBER(SEARCH(""*Master MCC*"",B:B)),ISNUMBER(SEARCH(""*Standards*"",B:B)),ISNUMBER(SEARCH(""*screen*"",B:B)),ISNUMBER(SEARCH(""*RTSS*"",B:B)),ISNUMBER(SEARCH(""*Heads*"",B:B)),ISNUMBER(SEARCH(""*Harps faulty*"",B:B)),ISNUMBER(SEARCH(""*TMSC*"",B:B)),ISNUMBER(SEARCH(""*Blind*"",B:B))), ""Blinders"", """")"
Sheets("Data").Range("P:P") = "=IF(OR(ISNUMBER(SEARCH(""*faulting*"",B:B)),ISNUMBER(SEARCH(""*Marker MN*"",B:B)),ISNUMBER(SEARCH(""*Elec M5*"",B:B)),ISNUMBER(SEARCH(""* Alarm*"",B:B)),ISNUMBER(SEARCH(""*Graber*"",B:B)),ISNUMBER(SEARCH(""*catcher*"",B:B)),ISNUMBER(SEARCH(""*Circuit*"",B:B)),ISNUMBER(SEARCH(""*Sal fault*"",B:B)),ISNUMBER(SEARCH(""*Panter*"",B:B)),ISNUMBER(SEARCH(""*Vigilance*"",B:B))), ""Misc"", """")"
Sheets("Data").Range("F:F") = "=I:I&J:J&K:K&L:L&M:M&N:N&O:O&P:P"
Sheets("Data").Columns("I:P").EntireColumn.Hidden = True
Sheets("Data").Range("F1").FormulaR1C1 = "System"
End Sub
You can use the power of vba to build the formulas and save you having to typing so much, Your question said column A but your code shows column B. I have used column B,
Sub Categorise()
Dim wsData As Worksheet, lastrow As Long
Set wsData = ThisWorkbook.Sheets(1)
With wsData
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Dim ar(8), isN() As String
ar(0) = Array("Seating", "chair fault", "chair noise")
ar(1) = Array("Angles", "Arm fail", "arm inhibition", "Gap in Arm", "No Arms", "All Arms")
ar(2) = Array("Comfort", "Couch", "Heating")
ar(3) = Array("Runners", "UDCD", "HDD flats", "HDD runner")
ar(4) = Array("Cabbies four", "Cabbies")
ar(5) = Array("Elec", "Braker")
ar(6) = Array("Blinders", "camera", "chough", "Master MCC", "Standards", "screen", _
"RTSS", "Heads", "Harps faulty", "TMSC", "Blind")
ar(7) = Array("Misc", "faulting", "Marker MN", "Elec M5", "Alarm", _
"Grabber", "catcher", "Circuit", "Sal fault", "panter", "Vigilance")
With wsData
.Range("I1:I" & lastrow) = Query(ar(0))
.Range("L1:L" & lastrow) = Query(ar(1))
.Range("M1:M" & lastrow) = Query(ar(2))
.Range("J1:J" & lastrow) = Query(ar(3))
.Range("K1:K" & lastrow) = Query(ar(4))
.Range("N1:N" & lastrow) = Query(ar(5))
.Range("O1:O" & lastrow) = Query(ar(6))
.Range("P1:P" & lastrow) = Query(ar(7))
.Range("F1:F" & lastrow) = "=I:I&J:J&K:K&L:L&M:M&N:N&O:O&P:P"
.Columns("I:P").EntireColumn.Hidden = True
.Range("F1").FormulaR1C1 = "System"
End With
MsgBox "Done"
End Sub
Function Query(ar) As String
Dim isN() As String, i As Integer
ReDim isN(UBound(ar) - 1)
For i = 1 To UBound(ar)
isN(i - 1) = "ISNUMBER(SEARCH(""*" & ar(i) & "*"",B:B))"
Next
If UBound(ar) > 1 Then
Query = "=IF(OR(" & Join(isN, ",") & "), """ & ar(0) & ""","""")"
Else
Query = "=IF(" & isN(0) & ", """ & ar(0) & ""","""")"
End If
Debug.Print Query
End Function

How can I compare two sheets and generate a new list using VBA?

Beforehand, be aware that I just began using VBA, and I have few coding experience prior to it.
I have two sheets:
public
contacts
There is one parameter on column A that is definitely on "contacts" sheet, but may be or not be on column A on "public" sheet.
What I'm doing is:
Checking if the parameter contacts.A2 is on public.A2.
If it is, I need to copy columns, on the exact order:
public: A, C, G.
contacts: E, F.
I've found the following code online, and I'm running some adaptations to it, but I'm stuck.
Sub match()
Dim I, total, frow As Integer
Dim found As Range
total = Sheets("public").Range("A" & Rows.Count).End(xlUp).Row
'MsgBox (total) '(verifica se a contagem está ok)
For I = 2 To total
pesquisa = Worksheets("public").Range("A" & I).Value
Set found = Sheets("contacts").Columns("A:A").Find(what:=pesquisa) 'finds a match
If found Is Nothing Then
Worksheets("result").Range("W" & I).Value = "NO MATCH"
Else
frow = Sheets("contacts").Columns("A:A").Find(what:=pesquisa).Row
Worksheets("result").Range("A" & I).Value = Worksheets("public").Range("A" & frow).Value
Worksheets("result").Range("B" & I).Value = Worksheets("public").Range("C" & frow).Value
Worksheets("result").Range("C" & I).Value = Worksheets("public").Range("G" & frow).Value
Worksheets("result").Range("D" & I).Value = Worksheets("contacts").Range("F" & frow).Value
Worksheets("result").Range("E" & I).Value = Worksheets("contacts").Range("G" & frow).Value
End If
Next I
End Sub
What I expect:
to the code do ignore the line 1, as those are headers;
to eliminate de IF above, since I don't need the "NO MATCH"
to the resulting list to be ordered on ascending order, based on the A column.
Can you help me?
edited to include samples of the data and expected results:
I believe I can simplify my needs with the images above. I want to check a client on the public sheet, grab the manager contacts (emails) from the contacts sheet, and create a list that contains branch, manager, and both e-mails on the results sheet.
Creating those images, I realized I have forgotten to account for the second parameter (manager), as there can be multiple managers on a branch. So this is another parameter to account for.
`Public sheet (image)
Contacts sheet(image)
Result sheet(image)
spreadsheet
`
As per my comments, and your updated question with sample, I do believe that your current results do not match that what you say is required; which is looking for both parameters "Branch" and "Manager". Neither does your expected result look like the columns you wanted to extract according to your question. However, going by your sample data and expected output I tried the following:
Sub BuildList()
'Define your variables
Dim x As Long, y As Long
Dim arr1 As Variant, arr2 As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
'Fill 1st array variable from sheet Contacts
With Sheet1 'Change accordingly
x = .Cells(.Rows.Count, 1).End(xlUp).Row
arr1 = .Range("A2:D" & x).Value
End With
'Fill dictionary with first array
For x = LBound(arr1) To UBound(arr1)
dict.Add arr1(x, 1) & "|" & arr1(x, 2), arr1(x, 3) & "|" & arr1(x, 4)
Next x
'Fill 2nd array variable from sheet Public
With Sheet2 'Change accordingly
x = .Cells(.Rows.Count, 1).End(xlUp).Row
arr2 = .Range("A2:B" & x).Value
End With
'Compare array against dictionary and fill sheet Results
With Sheet3 'Change accordingly
y = 2
For x = LBound(arr2) To UBound(arr2)
If dict.Exists(arr2(x, 1) & "|" & arr2(x, 2)) Then
.Cells(y, 1).Value = arr2(x, 1)
.Cells(y, 2).Value = arr2(x, 2)
.Cells(y, 3).Value = Split(dict(arr2(x, 1) & "|" & arr2(x, 2)), "|")(0)
.Cells(y, 4).Value = Split(dict(arr2(x, 1) & "|" & arr2(x, 2)), "|")(1)
y = y + 1
End If
Next x
End With
End Sub
This solution makes use of arrays and dictionary which should be fast. It has given me the following result:
As David suggested, it would be better to have an input and output sample. Maybe you can try this:
Option Explicit
Public Sub match()
Dim wsPub As Worksheet
Dim wsCon As Worksheet
Dim wsRes As Worksheet
Dim pubRow As Long
Dim conRow As Long
Dim resRow As Long
Dim i As Long
Dim rng As Range
Dim cel As Range
Dim found As Long
Dim order(1 To 5) As Integer
Set wsPub = ThisWorkbook.Worksheets("public")
Set wsCon = ThisWorkbook.Worksheets("contacts")
Set wsRes = ThisWorkbook.Worksheets("result")
pubRow = wsPub.Cells(wsPub.Rows.Count, 1).End(xlUp).Row
conRow = wsCon.Cells(wsPub.Rows.Count, 1).End(xlUp).Row
resRow = wsRes.Cells(wsRes.Rows.Count, 1).End(xlUp).Row
Set rng = wsPub.Range("A2:A" & pubRow)
order(1) = 1
order(2) = 3
order(3) = 7
order(4) = 6
order(5) = 7
For Each cel In rng
If Not IsError(Application.match(cel.Value, wsCon.Range("A2:A" & conRow), 0)) Then
found = Application.match(cel.Value, wsCon.Range("A2:A" & conRow), 0) + 1
resRow = wsRes.Cells(wsRes.Rows.Count, 1).End(xlUp).Row
For i = 1 To 5
If i < 4 Then
wsRes.Cells(resRow, i).Offset(1, 0).Value _
= cel.Offset(0, order(i) - 1).Value
Else
wsRes.Cells(resRow, i).Offset(1, 0).Value _
= wsCon.Cells(found, order(i)).Value
End If
Next
End If
Next
wsRes.Range("A1").AutoFilter
wsRes.AutoFilter.Sort.SortFields.Clear
wsRes.AutoFilter.Sort.SortFields.Add2 Key:= _
Range("A1:A" & resRow), SortOn:=xlSortOnValues, order:=xlAscending, DataOption:= _
xlSortNormal
wsRes.AutoFilter.Sort.Apply
End Sub

Run-time error '438': Object does't support this property or method

Following macro nearly works flawless up to one specific line.
Sub Top15()
Dim Top15 As Worksheet
Dim lastROW As Long
Dim last15ROW As Long
Dim rangeC As Range
Dim rangeH As Range
Dim rangeI As Range
Dim rangeJ As Range
Dim rangeK As Range
Dim rangeL As Range
Dim rangeM As Range
Dim rangeN As Range
Dim pasteRange As Range
Set Top15 = ThisWorkbook.Sheets("03")
lastROW = Top15.Range("C" & Top15.Rows.Count).End(xlUp).Row + 1
last15ROW = Top15.Range("C" & Top15.Rows.Count).End(xlUp).Row + 16
Set rangeC = Top15.Range("C" & lastROW & ":C" & last15ROW)
Set rangeH = Top15.Range("H" & lastROW & ":H" & last15ROW)
Set rangeI = Top15.Range("I" & lastROW & ":I" & last15ROW)
Set rangeJ = Top15.Range("J" & lastROW & ":J" & last15ROW)
Set rangeK = Top15.Range("K" & lastROW & ":K" & last15ROW)
Set rangeL = Top15.Range("L" & lastROW & ":L" & last15ROW)
Set rangeM = Top15.Range("M" & lastROW & ":M" & last15ROW)
Set rangeN = Top15.Range("N" & lastROW & ":N" & last15ROW)
With Top15
rangeC.Formula = "=TEXT(WEEKNUM(TODAY()),""0#"")" 'CW
rangeH.Formula = "=IF(ISBLANK(INDIRECT(""D""&ROW())),"""",INDIRECT(""D""&ROW())&""/""&TEXT(INDIRECT(""C""&ROW()),""0#""))" 'REF
rangeI.Formula = "=IFERROR(IF(RIGHT(VLOOKUP(INDIRECT(""D""&ROW())&""/""&TEXT(INDIRECT(""C""&ROW())-1,""0#""),H:H,1,FALSE),2)+1=INDIRECT(""C""&ROW()),INDIRECT(""C""&ROW()),1),1)" 'open weeks
rangeJ.Forumla = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,3,FALSE),"""")" 'Issue description
rangeK.Forumla = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,4,FALSE),"""")" 'action
rangeL.Formula = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,5,FALSE),"""")" 'reason
rangeM.Formula = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,6,FALSE),"""")" 'missing component
rangeN.Formula = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,7,FALSE),"""")" 'expected D CW
Set pasteRange = .Range(rangeC.Address & ":" & rangeN.Address)
pasteRange.Copy
pasteRange.PasteSpecial xlPasteValues
End With
End Sub
The first three functions work but I'm getting the run-time error at the third one:
With Top15
rangeC.Formula = "=TEXT(WEEKNUM(TODAY()),""0#"")" 'CW
rangeH.Formula = "=IF(ISBLANK(INDIRECT(""D""&ROW())),"""",INDIRECT(""D""&ROW())&""/""&TEXT(INDIRECT(""C""&ROW()),""0#""))" 'REF
rangeI.Formula = "=IFERROR(IF(RIGHT(VLOOKUP(INDIRECT(""D""&ROW())&""/""&TEXT(INDIRECT(""C""&ROW())-1,""0#""),H:H,1,FALSE),2)+1=INDIRECT(""C""&ROW()),INDIRECT(""C""&ROW()),1),1)" 'open weeks
rangeJ.Forumla = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,3,FALSE),"""")" 'Issue description
rangeK.Forumla = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,4,FALSE),"""")" 'action
rangeL.Formula = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,5,FALSE),"""")" 'reason
rangeM.Formula = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,6,FALSE),"""")" 'missing component
rangeN.Formula = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,7,FALSE),"""")" 'expected D CW
This is the formula that is giving me the run-time error->
rangeJ.Forumla = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,3,FALSE),"""")" 'Issue description
Anyone knows why VBA has a problem with that formula?
you have mispelled the range.Formula
Your line:
rangeJ.Forumla =
Should be:
rangeJ.Formula =
Happens twice:
rangeJ.Forumla = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,3,FALSE),"""")" 'Issue description
rangeK.Forumla = "=IFERROR(VLOOKUP((INDIRECT(""D""&ROW())&""/""&TEXT((INDIRECT(""C""&ROW())-1),""0#"")),$H:$N,4,FALSE),"""")" 'action
Please mark answer as correct if you agree.
Hope it helps!

Move Two characters from beginning to end of string VBA

I need to create a VBA script in excel that chanages an order number from having "CD" at the front to "CD" at the end so from "CD00001" to "00001CD"
Any help would be awesome. all of the order numbers are in Column B and start at row 5. please help.
What i have so far:
Private Sub OrderNumber_Click()
Dim Val As String
Dim EndC As Integer
EndC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To EndC
Val = Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2)
Range("B" & i).Value = Val
Next
End Sub
This replaces the order numbers with B5, B6 and so on but if i put this function into Excel itself it works fine.
Like this? DO you want it in column B?
Option Explicit
Private Sub OrderNumber_Click()
Dim i As Long
Dim val As String
Dim EndC As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Raw Data Upload")
EndC = ws.Range("A1048576").End(xlUp).Row
For i = 5 To EndC
val = ws.Cells(i, "A")
Range("B" & i).Value = Mid$(val, 3, Len(val) - 2) & Left$(val, 2)
Next i
End Sub
dim beginStr, endStr, originalStr, outputStr as string
dim rng as range
'put the below into a loop, assigning a rng to the desired cell each time
originalStr = rng.value ' Change to chosen range
beginStr = left(originalStr,2)
endStr = right(originalStr, len(originalStr) - 2)
outputStr = endStr + beginStr
Range("B" & i).Value = outputStr
I haven't got a copy of Excel to test this on but it should work.
Simply use:
Right(Range("B" & i), Len(Range("B" & i)) - 2) & Left(Range("B" & i), 2)
An alternative is to set up the cell as a Range():
Sub t()
Dim cel As Range
Dim endC As Long
endC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To endC
Set cel = Range("B" & i)
myVal = Right(cel, Len(cel) - 2) & Left(cel, 2)
Range("B" & i).Value = myVal
Next
End Sub
Currently, when you do Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2), for row 5, this becomes Right("B5", Len("B5") - 2) & Left("B5", 2) then this evaluates to simply:
Right("B5",0) & Left("B5",2), which is
[nothing] & B5, finally becoming
B5
Note the lack of using B5as a range. Instead it's being treated as a string.
(Also, I'm assuming this is to be run on the ActiveSheet. If not, please add the worksheet before the range, i.e. Worksheets("Raw Data Upload").Range("B" & i)...)
Try this
Private Sub OrderNumber_Click()
Dim cell As Range
With Worksheets("Raw Data Upload")
For Each cell in .Range("B5", .Cells(.Rows.Count, 2).End(xlUp))
cell.Value = Right(cell.Value, Len(cell.Value) - 2) & Left(cell.Value, 2)
Next
End With
End Sub

Resources