I am compiling a list of employees CPD classes and the hours they are, producing a printout essentially for each one. I am pulling data from multiple worksheets and am having trouble with VLOOKUP continually finding the same data. My code currently is:
result = lookup.Find(name) Is Nothing
If (result = False) Then
For Each cell In lookup
className = Application.VLookup(name, lookup, 7, True)
classHours = Application.VLookup(name, lookup, 9, True)
Sheets("employee output").Range("B" & counter).Formula = className
Sheets("employee output").Range("C" & counter).Formula = classHours
empHours = empHours + classHours
counter = counter + 1
numClasses = numClasses + 1
corporate = Range("B" & i) *** vba precompliles the loop so this doesn't work *
Set lookup = Range("corporate:K") ** doesn't work either***
Next
End If
So I need to limit the scope of the lookup range or somehow avoid finding the same data. Any help would be greatly appreciated...
I assume your lookup variable represents the range containing you data.
Your data duplication propably comes from your for each loop. Indeed, you are iterating trough each Cell of your range. That means that once the name is found, the code Inside the loop is executed as many times as there are cells in the range lookup.
Try changing your loop to the following:
Dim row as Range
for each row In lookup.Row
'your code goes here
Next
Whit this, the code will only run once for each rows.
Related
I'm trying to find "blocks" in the worksheet that have dates in the A-column. A block is seperated by lines as you can see from the picture. The whole file is full of these blocks but I only need the blocks that have dates in the A-column. Just to be clear I don't just need the rows with the dates but the full block that contains the date.
A block in my files for example is the Range A172:G192.
Picture of the file:
[![enter image description here][1]][1]
How should I continue after selecting the first block? I probably should use the Find function starting from row 184 or the row of ResultDown variable moving down the sheet on "A" Column. However the row needs to be dynamic, so I can use it for the next block. Also I have no idea how many blocks there will be, so I would like to hear from you how to solve this aswell.
I would like to save all the blocks as different variables and then hide all the blocks in the worksheet and then just unhide the blocks that I stored in the variables.
My biggest problem is the last row.
Result2 = Range(Cells(StartcellRow, 1), Cells(1000, 1)).Find(What:="**/**/****", After:=Range(Cells(StartcellRow, 1))).Select
I keep getting an runtime error 1004
Public Sub FB_MAKRO()
Dim FBwb As Workbook
Dim FBsht As Worksheet
Dim ACol As Range
'Set variables for workbook and sheet
Set FBwb = Workbooks.Open(Filename:="C:\Users\l000xxx\Desktop\Makrot\FORCED BALANCE MAKRO\FB HARJOITUS.xls")
Set FBsht = FBwb.Sheets("Forced Balance")
Set ACol = FBsht.Range("A1:A1000")
'I want ACol variable to be the entire A-Column. Any ideas?
'For some reason the range function is not working here?
'This locates the date in A'column, so I can select the correct block
Result = Range("A3:A1000").Find(What:="**/**/****", After:=Range("A3")).Address
'This is the top left corner of the Block1 selection
ResultUp = Range(Result).End(xlUp).Offset(-1, 0).Address
Range(ResultUp).End(xlDown).Select
Range(ActiveCell, ActiveCell).End(xlDown).Select
'The ResultsDownLastRow variable is for Block2 find function
'ResultDown is the bottom right corner of the Block1
ResultsDownLastRow = Range(ActiveCell, ActiveCell).End(xlDown).Address
ResultDown = Range(ActiveCell, ActiveCell).End(xlDown).Offset(-2, 6).Address
'First Block assigned. I plan to use this in the end when I hide everything and then unhide these blocks
Block1 = Range(ResultUp, ResultDown).Select
' NEXT BLOCK STARTS HERE
'StartCellRow is the cell that the find function should start looking for Block2
'Result2 is the find function for Block2
StartcellRow = Range(ResultsDownLastRow).Row
Result2 = Range(Cells(StartcellRow, 1), Cells(1000, 1)).Find(What:="**/**/****", After:=Range(Cells(StartcellRow, 1))).Select
End Sub
'This returns value 194
StartcellRow = Range(ResultsDownLastRow).Row MsgBox StartcellRow
'This should work but doesn't. I get a syntax error
Range(Cells(StartcellRow &","& 1),Cells(1000 & "," & 1)).Find(What:="**/**/****", After:=Range(Cells(StartcellRow& ","& 1)).Select
This doesn't work either
'StarcellRow gives out value of 194
StartcellRow = Range(ResultsDownLastRow).Row
Result2 = Range("A&:StartcellRow:A648").Find(What:="**/**/****", After:=Range("A&:StartcellRow")).Select
This doesn't give me a syntax error but it's not working
I would search for all currency header and store their rownumber into an array. For each rownumber in the array i would look into the cell below (rownumber + 1). when there is a date in the cell, i would set the range in the following way:
set rangeWithDate = Range(Cells(actualRowNumberInArray - 1, 1), Cells(nextRowNumberInArray - 2, 7))
Array:
Dim array1() As long
Redim array1(5)
For i = 1 To 5
array(i) = i
Next i
Redim array1(10) ' changes the "length" of the array, but deletes old entries
For i = 1 To 10
Feld1(i) = i
Next i
Redim Preserve array1(15) ' changes the "length" of the array without deleting old entries
How do i write the following code as a loop. I want to copy values from a table in sheet 4 in a row from range (b:17:L17"). is there a more efficient way to do it with loops ?
ActiveSheet.Range("B17").Value = Sheets(4).Range("G8")
ActiveSheet.Range("C17").Value = Sheets(4).Range("G9")
ActiveSheet.Range("D17").Value = Sheets(4).Range("G10")
ActiveSheet.Range("E17").Value = Sheets(4).Range("G11")
ActiveSheet.Range("F17").Value = Sheets(4).Range("G12")
ActiveSheet.Range("G17").Value = Sheets(4).Range("G13")
ActiveSheet.Range("H17").Value = Sheets(4).Range("G14")
ActiveSheet.Range("I17").Value = Sheets(4).Range("G15")
ActiveSheet.Range("J17").Value = Sheets(4).Range("G16")
ActiveSheet.Range("K17").Value = Sheets(4).Range("G17")
ActiveSheet.Range("L17").Value = Sheets(4).Range("G18")
Yes, there is:
ActiveSheet.Range("B17:L17").Value = Application.Transpose(Sheets(4).Range("G8:G18").Value)
You can, using something like this (VB.Net, but may copy easily to VBA):
Dim cell as Integer, c as Integer
cell = 8
For c = 66 To 76
ActiveSheet.Range(Chr(c) & "17").Value = Sheets(4).Range("G" & cell)
cell = cell + 1
Next
The Chr() function gets the character associated with the character code (66-76), and then this value is concatenated with the string "17" to form a complete cell name ("B17", "C17", ...)
I am also incrementing the cell number for G at the same time.
Use this if you really want to use a loop - but there could be better ways, like the answer given by #A.S.H
Solution explanation:
Establish your rules! What is changing in the range for active sheet? The column is going to grow as the for/to cycle does! So, we should sum that to it. What is the another thing that is going to increment? The Range in the other side of the '=' so, by setting an algorithm, we may say that the row is const in the Activesheet range and the column is the on variable on the other side.
Solution:
Sub Test()
Const TotalInteractions As Long = 11
Dim CounterInteractions As Long
For CounterInteractions = 1 To TotalInteractions
'where 1 is column A so when it starts the cycle would be B,C and so on
'where 7 is the row to start so when it begins it would became 8,9 and so on for column G
ActiveSheet.Cells(17, 1 + CounterInteractions).Value = Sheets(4).Cells(7 + CounterInteractions, 7)
Next CounterInteractions
End Sub
This is probably your most efficient solution in a with statement:
Sub LoopExample()
Sheets("Sheet4").Range("G8:G18").Copy
Sheets("Sheet2").Range("B17").PasteSpecial xlPasteValues, Transpose:=True
End Sub
I have a macro that so far, adds 4 new table columns to an existing table ("Table1"). Now, I would like the macro to format the 3rd and 4th row as percentage. I would like to include this in the loop already listed in my code. I have tried several different ways to do this. I don't think I quite understand how the UBound function works, but hopefully you can understand what I am trying to do.
I also am unsure if I am allowed to continue to utilize the WITH statement in my nested For loop in regards to me 'lst' variable.
#Jeeped - I'm looking at you for this one again...thanks for basically walking me through this whole project lol
Sub attStatPivInsertTableColumns_2()
Dim lst As ListObject
Dim currentSht As Worksheet
Dim colNames As Variant, r1c1s As Variant
Dim h As Integer, i As Integer
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
Set lst = ActiveSheet.ListObjects("Table1")
colNames = Array("AHT", "Target AHT", "Transfers", "Target Transfers")
r1c1s = Array("=([#[Inbound Talk Time (Seconds)]]+[#[Inbound Hold Time (Seconds)]]+[#[Inbound Wrap Time (Seconds)]])/[#[Calls Handled]]", "=350", "=[#[Call Transfers and/or Conferences]]/[#[Calls Handled]]", "=0.15")
With lst
For h = LBound(colNames) To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If UBound(colNames(h)) = 2 or UBound(colNames(h)) = 3 Then
For i = UBound(colNames(h), 2) To UBound(colNames(h), 3)
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next i
Next h
End With
End Sub
You don't need to nest a second for loop. If you want to set the 3rd and 4th columns to a percentage, you only need to set that when the iteration of the loop (h) is 2 or 3 (remembering that arrays index from 0). You also shouldn't cross arrays for the main loop, and since LBound is in most cases 0 you might as well just use that anyway. Try this:
With lst
For h = 0 To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If h = 2 or h = 3 Then
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next h
End With
To answer the other point in your question, UBound(array) just gives the index of the largest element (the Upper BOUNDary) in the given array. So where you have 50 elements in such an array, UBound(array) will return 49 (zero based as mentioned before). LBound just gives the other end of the array (the Lower BOUNDary), which is generally zero.
I have a large data set which I need to manipulate and create individual worksheets. Within column B all cells which are coloured Green I would like to make a new worksheet for. Please see screen shot.
For example I would like to create worksheets titled "Shopping" & "Retail". Once the worksheet is created, I would then like to copy all the data between the "worksheet title" (Green Cells) from columns ("B:C") & ("AI:BH") Please see screen shot below for expected output;
The code I have so far is below as you can see it is not complete as I do not know how I would go about extracting data between the "Green Cells".
Sub wrksheetadd()
Dim r As Range
Dim i As Long
Dim LR As Long
Worksheets("RING Phased").Select
LR = Range("B65536").End(xlUp).Row
Set r = Range("B12:B" & (LR))
For i = r.Rows.Count To 1 Step -1
With r.Cells(i, 1)
If .DisplayFormat.Interior.ColorIndex = 35 Then
MsgBox i
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Cells (i,1).Value
Worksheets("RING Phased").Select
End If
End With
Next i
End Sub
Any help around this would be much appreciated.
Sorry for taking a while to get back to this, I've been somewhat busy the last few days, so I haven't had much time to be on StackOverflow.
Anyway, the way I'd go about this would be to store all the found values in an array, and then loop through that array in order to find the distance between them.
The following code works for me, using some very simplified data, but I think the principle is sound:
Option Explicit
Option Base 0
Sub wrksheetadd()
Dim r As Range, c As Range
Dim i As Long: i = 0
Dim cells_with_color() As Range: ReDim cells_with_color(1)
With Worksheets("RING Phased")
' Since it doesn't seem like the first cell you want to copy from is colored, hardcode that location here.
' This also saves us from having to test if the array is empty later.
Set cells_with_color(i) = .Range("B12")
i = i + 1
Set r = Range(.Range("B13"), .Range("B" & .Cells.Rows.Count).End(xlUp))
' Put all the cells with color in the defined range into the array
For Each c In r
If c.DisplayFormat.Interior.ColorIndex = 35 Then
If i > UBound(cells_with_color) Then
ReDim Preserve cells_with_color(UBound(cells_with_color) + 1)
End If
Set cells_with_color(i) = c
i = i + 1
End If
Next
' Loop through the array, and copy from the previous range value to the current one into a new worksheet
' Reset counter first, we start at 1, since the first range-value (0 in the array) is just the start of where we started checking from
' (Hmm, reusing variables may be bad practice >_>)
i = 1
While i <= UBound(cells_with_color)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = cells_with_color(i).Value
' Set the range to copy - we could just do this in the copy-statement, but hopefully this makes it slightly easier to read
Set r = .Rows(CStr(cells_with_color(i - 1).Row) + 1 & ":" & CStr(cells_with_color(i).Row))
' Change the destination to whereever you want it on the new sheet. I think it has to be in column one, though, since we copy entire rows.
' If you want to refine it a bit, just change whatever you set r to in the previous statement.
r.Copy Destination:=Worksheets(CStr(cells_with_color(i).Value)).Range("A1")
i = i + 1
Wend
End With
End Sub
It probably lacks some error-checking which ought to be in there, but I'll leave that as an exercise to you to figure out. I believe it is functional. Good luck!
I have the following code
For i = 1 To DepRng.Rows.Count
For j = 1 To DepRng.Columns.Count
DepRng.Cells(i, j) = Application.Sum(KidsRng.Row(i)) //Does not work
Next j
Next i
Although I know is wrong, i have no idea how to get it to store in DepRng.Cells(i, j) the total sum of the whole KidsRng.Row[i] Any help?
The following code works ok.
Perhaps you should compare it with yours:
Sub a()
Dim DepRng As Range
Dim kidsrng As Range
Set DepRng = Range("B1:B2")
Set kidsrng = Range("C1:F2")
For i = 1 To DepRng.Rows.Count
DepRng.Cells(i, 1) = Application.Sum(kidsrng.Rows(i))
Next i
End Sub
Just fill the range C1:F2 with numbers and the totals per row will appear in B1:B2 upon execution of the macro.
Sorted, thanks all for ur help
DepRng.Cells(i, j) = Application.Sum(KidsRng.Rows(i)) //just needed to add the "s" in rows
There may be a better way than this, but this is my solution which depends on the internal Excel formula engine though, it might be sufficient enough for what you're doing... It determines the full address of KidsRng.Row(i), and feeds it into a =SUM() formula string and evaluated by Application.Evaluate.
For i = 1 To DepRng.Rows.Count
For j = 1 To DepRng.Columns.Count
DepRng.Cells(i, j).Value = Application.Evaluate("=SUM(" & KidsRng.Row(i).Address(True, True, xlA1, True) & ")")
Next j
Next i
updated it to work if kidsrng existed in a different sheet/book
updated to use Application.Evaluate