I have a Sub I am writing that has a SUMIFS statement included in it. I am wanting the sum if to sum a certain column (yearRange.Offset(0,i+3)) when yearRange matches gEvent Value and yearRange.Offset(0, 2) matches gEvent.Offset(0,2) Value. I have tried googling the issue, and checked the MSDN website (which was not very descriptive) and cannot get the function to work. The only possible idea I have is that criteria I am using are Strings rather than Integers. So gEvent.Value may be "ABCD" and gEvent.Offset(0,2) may be "DEFG".
When I try to run the code it is breaking here:
itemPY = Application.WorksheetFunction.SumIfs(yearRange.Offset(0, i + 3), yearRange.Value, "=" & gEvent.Value & """, yearRange.Offset(0, 2), " = " & gEvent.Offset(0, 2).Value & """)
And the error I am receiving is:
Run-time error '424':
Object required
Here is the sub in it's complete form:
Sub CombineData()
Dim eventSheet As Worksheet
Dim yearSheet As Worksheet
Dim yearRange As Range
Dim eventRange As Range
Dim gYear As Range
Dim gEvent As Range
Dim i As Integer
Dim itemCount As Integer
Dim itemPY As Integer
Set eventSheet = ThisWorkbook.Sheets("previousEvent")
Set yearSheet = ThisWorkbook.Sheets("previous12")
Set eventRange = eventSheet.Range("A3", eventSheet.Range("A3").End(xlDown))
Set yearRange = yearSheet.Range("A4", yearSheet.Range("A4").End(xlDown))
For Each gEvent In eventRange
i = 0
gEvent.Offset(0, 16).Value = gEvent.Value
gEvent.Offset(0, 17).Value = gEvent.Offset(0, 1).Value
gEvent.Offset(0, 18).Value = gEvent.Offset(0, 2).Value
itemCount = Application.WorksheetFunction.CountIf(yearRange, gEvent.Value)
For i = 0 To 11
itemPY = Application.WorksheetFunction.SumIfs(yearRange.Offset(0, i + 3), yearRange.Value, "=" & gEvent.Value & """, yearRange.Offset(0, 2), " = " & gEvent.Offset(0, 2).Value & """)
gEvent.Offset(0, 19 + i).Value = itemPY / Item
Next i
Next gEvent
End Sub
Any help I could get would be great.
No need for all that quoting:
itemPY = Application.WorksheetFunction.SumIfs(yearRange.Offset(0, i + 3), _
yearRange, gEvent.Value, _
yearRange.Offset(0, 2), gEvent.Offset(0, 2).Value)
Related
Sub Goal Seek()
Dim i As Integer
Dim ResultQty As Integer
Dim ChangingCell As Integer
Dim TargetSales As Integer
For i = 4 To 18
TargetSales = Cells(i,7).value
Cells(i, 6).Formula = "(C" & i & "*" & "E" & i & ")"
Set ResultQty = Cells(i,6).value
Set ChangingCell = Cells(i,3).value
ResultCell.GoalSeek TargetSales, ChangingCell
Next i
End Sub
I want to get the Qty from goal seeker by setting the targeted sales. But the code shows error. Can anyone help with it?
'=' missing in formula cell, target cell should not be integer as values are higher than range allowed
Sub GoalSeek()
Dim i As Integer
Dim ResultCell As Range
Dim TargetSales As Variant
For i = 4 To 18
Set ResultCell = Cells(i, 3)
TargetSales = Cells(i, 7).Value
Set ResultCell = Cells(i, 6)
ResultCell.Formula = "=(C" & i & "*" & "E" & i & ")"
ResultCell.GoalSeek TargetSales, Range("C" & i)
Next i
End Sub
I'm writing a macro to concatenate a few columns into another column for a sheet that will eventually have thousands of rows. For the sake of testing I'm using four rows of data. My issue is that the Cells(i,25).Value is not populating when I run the following code. The code isn't breaking and I'm not getting any error messages. I tried assigning a 2 to column 26 using Cells(i,26) and that wasn't working either.
Sub concat()
Dim i As Long
Dim add As String
i = 1
Do Until IsEmpty(Cells(i, 1))
add = Cells(i, 14).Value
Cells(i, 25).Value = Cells(i, 1).Value & " " & Cells(i, 2).Value & " " & Left(add, 3)
i = i + 1
Loop
End Sub
Any help or recommendations would be greatly appreciated!
I recommend you change the code a little. I have used the IsEmpty command before and it's not the most suitable one for this.
Sub concat()
Dim i As Long
Dim add As String
Dim last_1 As Long
Dim last_2 As Long
Dim last_14 As Long
Dim lastCell As Long
last_1 = Sheets("test3").Cells(Rows.Count, 1).End(xlUp).Row
last_2 = Sheets("test3").Cells(Rows.Count, 2).End(xlUp).Row
last_14 = Sheets("test3").Cells(Rows.Count, 14).End(xlUp).Row
lastCell = WorksheetFunction.Max(last_1 , last_2, last_14)
For i = 1 To lastCell
add = Sheets("test3").Cells(i, 14).Value
Sheets("test3").Cells(i, 25).Value = Sheets("test3").Cells(i, 1).Value & " " & Sheets("test3").Cells(i, 2).Value & " " & Left(add, 3)
Next i
End Sub
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
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
Good morning! I'm trying to create a VBA function and appreciate any help you can provide to get me on the right track. In short, for each value in Column A of Worksheet Exams, I need to concatenate all the unique values in Column B in Worksheet Findings in which Column A of Worksheet Exams = Column A of Worksheet Findings. I'm struggling with where to start, and can't seem to find any good guidance. In advance, thank you for your help. Much appreciated.
Started with this to get my bearings on the concat... I know the & ExamID portion is wrong, but I'm not sure what code I need there to Concatenate with the next instance of that RX721502:
Dim ExamID As Range
Dim strConcat As String
Dim i As Integer
i = 2
Do While Cells(i, 1).Value <> ""
For Each ExamID In Range("A2:A10000")
If InStr(ExamID.Value, "RX721502") > 0 Then
Cells(i, 18).Value = ActiveCell.Offset(0, 10) & ", " & ExamID
End If
Next ExamID
Cells(2, 18) = Trim(Cells(2, 18))
i = i + 1
Loop
G
try the following code, it puts the Concatenate string of Cities in Worksheet SourceExams, Column 2.
Sub use_VLookup()
Dim conOG As String
Dim SourceExams As Worksheet
Dim SourceFindings As Worksheet
Dim lastrow, lastrow2 As Long
Dim rowfound As Long
Dim Vlookup_result As Variant
Set SourceExams = ActiveWorkbook.Sheets("Source-Exams")
Set SourceFindings = ActiveWorkbook.Sheets("Source-Findings")
lastrow = SourceExams.UsedRange.Rows.count
lastrow2 = SourceFindings.UsedRange.Rows.count
For i = 2 To lastrow
j = 2
While j <= lastrow2
' search Worksheet Cities workcheet for match on Column A, and return the value in column B
Vlookup_result = Application.VLookup(SourceExams.Cells(i, 1), SourceFindings.Range(SourceFindings.Cells(j, 1), SourceFindings.Cells(lastrow2, 2)), 2, False)
If IsError(Vlookup_result) Then
' do nothing , you can add erro handling, but I don't think it's necesary
Else
conOG = conOG & ", " & Application.WorksheetFunction.VLookup(SourceExams.Cells(i, 1), SourceFindings.Range(SourceFindings.Cells(j, 1), SourceFindings.Cells(lastrow2, 2)), 2, False)
rowfound = Application.WorksheetFunction.Match(SourceExams.Cells(i, 1), SourceFindings.Range(SourceFindings.Cells(j, 1), SourceFindings.Cells(lastrow2, 1)), 0)
End If
j = j + rowfound
' if first found go to row 3
If j <= 2 Then j = 3
Wend
SourceExams.Cells(i, 2) = conOG
conOG = ""
Next i
End Sub