I am trying to automate a process to generate 2 XYScatter graphs from 1 table and seem to be making a mess of it. There are multiple issues I'm hitting so I will try to describe 1 at a time.
The first issue is setting the X & Y ranges. The table could contain anywhere from 4 to a few hundred rows. Column A = X values, column F says if it is level 1/graph 1 or level 2/graph 2, & column J = Y value. I created 4 Range variables, RngL1X, RngL1Y, RngL2X & RngL2Y. Then I wrote some code to loop through column F and fill the data ranges (see below).
What is the correct syntax to make an empty range? Before I can use them, the ranges need to have initial values. I would like to set them to "Empty" but VBA doesn't like any of the syntax I have tried: Set RngL1X = " ", RngL1X = IsNull, RngL1X = IsEmpty, etc.
Here's the loop code for filling the variables. I can't tell how well it will work until I solve the problem of the initial values.
Range("F2").Select
Do While IsEmpty(ActiveCell) = False
If ActiveCell Like "*Level 1*" Then
RngL1X = RngL1X & ", " & ActiveCell.Offset(0, -5)
RngL1Y = RngL1Y & ", " & ActiveCell.Offset(0, 4)
Else
RngL2X = RngL2X & ", " & ActiveCell.Offset(0, -5)
RngL2Y = RngL2Y & ", " & ActiveCell.Offset(0, 4)
End If
Debug.Print RngL2Y
ActiveCell.Offset(1, 0).Select
Loop
When I tested the loop with the variables as a string (not a range) it worked well.
Related
I have 32.000 rows with data. Some data are in a different place and I want to join them with something that I can apply to all rows and not manually. Each "group" have the same ID, in this example is "XPTO"
I have something like this now (but with more columns):
I want it to be like this:
The problem is that I need a clever way, because they are not always exactly like this example. Some of them have 10 rows with the same ID "XPTO" (example)
I am struggling with this =/ ty
Here's how I would approach this.
1) From your comment, I understand that the logic is positional (the first one on the left (Casteloes de) goes with the first one on the right (R Dr Antonio) for the matching value in column A. If that is true, then I would insert a column where you start numbering sequentially, then Fill Down to get sequential numbers all the way to the end. This will help preserve the positional logic if you need to sort or rearrange your data. It will also help you with the logic of "first match", "second match", etc.
2) My next step would be to separate the two sets of data into separate tables/tabs (with the sequentially numbered column appearing in each) and use INDEX/MATCH. The recent answer here will help you with how to increment the match: Is there such thing as a VLOOKUP that recognises repeated numbers?
3) Alternative - this may even be easier, although you'll want to do extensive data checking to make sure nothing got screwed up. With the two tables from step 2, sort by any column with data in it, then delete the blank rows from each table. Then, sort each by the sequentially numbered column to return to the original order. At that point you may be able to just copy and paste. Check carefully for errors if you do this.
I am positive that the solution above given by CriketBird work, at least it has a good logic to solve it, but since I am a newbie in excel, I couldn't figure it out how to solve it that way.
So I solved it by using VBA in excel...(maybe I went too far for this simple problem, but it was my only option).
I will leave the code here if someone want it for a similar situation. (just select the first column and row your table starts and hit run)
Function Area(medico As String) As Integer
Do While countOk < 1
If medico = ActiveCell.Value Then
ActiveCell.Offset(1, 0).Select
rowCount = rowCount + 1
Else: countOk = 1
End If
Loop
Area = rowCount
End Function
Sub Teste()
Dim PaginaMedico As String
Dim totalrowCount As Integer
Dim rowCount As Integer
Dim countOk As Integer
Dim right As Integer
Dim left As Integer
Dim listaleft As New Collection
Dim listaright As New Collection
rowCount = 1
rowOk = 0
totalrowCount = 0
right = 0
left = 0
Do While ActiveCell.Value <> 0
PaginaMedico = ActiveCell.Value
rowCount = Area(PaginaMedico)
totalrowCount = totalrowCount + rowCount
Range("A" & (totalrowCount - (rowCount - 1))).Select
For i = ((totalrowCount + 1) - rowCount) To totalrowCount
If IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Empty"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Full"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
left = left + 1
listaleft.Add i
ElseIf IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
right = right + 1
listaright.Add i
End If
Next i
If Not (right = left) Then
Range("T" & totalrowCount).Value = "BOSTA"
right = 0
left = 0
End If
If listaleft.Count = listaright.Count Then
For i = 1 To listaleft.Count
Range("F" & listaright(1) & ":" & "S" & listaright(1)).Cut Range("F" & listaleft(1) & ":" & "S" & listaleft(1))
listaright.Remove (1)
listaleft.Remove (1)
Next i
End If
Set listaleft = New Collection
Set listaright = New Collection
Range("A" & (totalrowCount + 1)).Select
Loop
End Sub
I created a macro which summarizes a series of Excel forms into outputs, organized by sheets, rows and columns. The program creates a sheet, populates a table, and repeats.
The only thing I have left to do is to populate the cells with a formula. It's a very simple AverageIfs formula and I am getting the "Unable to get Averageifs property of WorksheetFunction class" error. I tried a bunch of things that I read, but to no avail.
So far I
Copied and pasted the formula itself into a separate macro (it ran, so it isn't a typo)
Removed the formula and checked to make sure every variable in the formula is the value I expect it to be at this point in the program (each one is)
Here is the relevant excerpt of my code. I am omitting a large portion, but I can assure all variables are defined and the loop works properly if I replace the AverageIfs function with a hard value (e.g. "1").
'Start Loop
VBid = 0
ZEval = 0
Do While VBid <> NumBidder
ActiveBid = ListInputSheet.Range("H" & 7 + VBid).Value
Set AnalysisSheet = AnalysisBook.Sheets.Add
AnalysisSheet.Name = ActiveBid
XRow = 4
AnalysisSheet.Range("C" & XRow).Value = ActiveBid
ZEval = 0
'Loop all evaluators down rows
Do While ZEval <> NumEval
ActiveEval = ListInputSheet.Range("E" & 7 + ZEval).Value
AnalysisSheet.Range("D" & XRow).Value = ActiveEval
AnalysisSheet.Range("D" & XRow).Select
WSub = 0
'Loop all Category Averages across row in columns
Do While WSub <> NumCategories
ActiveCell.Offset(0, 1).Select
Form = Application.WorksheetFunction.AverageIfs(SummarySheet.Range("F1:F10000"), SummarySheet.Range("A1:A10000"), ActiveEval, SummarySheet.Range("B1:B10000"), ActiveBid, SummarySheet.Range("D1:D10000"), WSub + 1)
ActiveCell.Value = Form
WSub = WSub + 1
Loop
XRow = XRow + 1
ZEval = ZEval + 1
Loop
'End evaluator loop
VBid = VBid + 1
Loop
'End Bidder loop
I have encountered the same error and couldn'd find a reason for a while, but later figured out that it is a issue with the data. It seems for the average function we need more than one row of data to work, so when I added additional rows of data it started working fine without any issue.
Here's an alternative if you cannot get it going. Just swap this line of code for you AverageIfs line:
Form = SummarySheet.Evaluate("AverageIfs(F1:F10000,A1:A10000," & ActiveEval & ",B1:B10000," & ActiveBid & ",D1:D10000," & WSub + 1 & ")")
For innerLoop = 0 To addRowOffset = 1
Range("C" & countRow & ":" & "C" & (countRow + addRowOffset)).Value = _
ThisWorkbook.Sheets("Template").Range("B" & (4 + innerLoop)).Value
Next
So I have this code which is supposed to take some rows that I inserted into a sheet, and fill Colum "C" with the a range of strings from the "Template" sheet. However, all it does it put one string and copy over and over again into the cells. How, do I get this to put the entire range of strings into the other sheet?
I'm willing to provide more of the code, or information if needed.
You seem to be putting the same value from the Template worksheet into all of the Range("Cx") cells at once. You put different values in but you replace all of the Range("Cx") cells each time during the loop.
For innerLoop = 0 To addRowOffset
Range("C" & countRow + innerLoop).Value = _
Sheets("Template").Range("B" & (4 + innerLoop)).Value
Next innerLoop
That should put a different value into a different cell for each iteration of the loop.
Note the change in For innerLoop = 0 To addRowOffset as well.
I have an Excel project which has a few thousand rows containing strings which need sorting out.
Typically one cell in each row should have a six digit number 123456 but many are 123456/123456/234567 etc. which need to have the / deleted and then be separated onto individual rows. There is other information in the surrounding columns which needs to stay with these six digit numbers.
I decided to approach this by firstly making copies of the rows the appropriate number of times and then deleting the surplus information
This code below deals with the copying part and it works.. but it's really slow. Is there a quicker way to achieve what I'm trying to do?
Thanks for any help.
Chris
Sub Copy_extra_rows()
Application.ScreenUpdating = False
s = 2
Do Until s = Range("N20000").End(xlUp).Row
'checks for / in Mod list
If InStr(1, Range("N" & s), "/") Then
'determines number of /
x = Len(Range("N" & s)) - Len(Replace(Range("N" & s), "/", ""))
'loops x times and copies new row
For a = 1 To x
Range("J" & s & ":O" & s).Select
Selection.Copy
Range("J" & s + 1).Select
Selection.Insert Shift:=xlDown
s = s + 1
Next a
Else
End If
s = s + 1
Loop
End Sub
I would have approached this differently to optimize the process and improve the overall efficiency of code.
Firstly, I would load the entire column into an array. This way it's always faster to access the elements of that array rather then referring Cells() multiple times in loops. Working with objects in memory is much faster because your client doesn't need to for example update the UI. Generally, arrays big O is O(1) which means you instantly can access an object/data stored at a specific index.
Let's consider an SSCCE.
Then the code (*Note: I have added comments in the code in the right places, hopefully that helps you understand what is going on)
Sub Main()
Dim columnArray As Variant
' create an array from Range starting at L2 to the last row filled with data
columnArray = Range("N2:N" & Range("N" & Rows.Count).End(xlUp).Row)
Dim c As New Collection
' add separate 6 digit numbers to the collection as separate items
' iterate the columnArray array and split the contents
Dim element As Variant
For Each element In columnArray
If NeedSplitting(element) Then
Dim splittedElements As Variant
splittedElements = Split(element, "/")
Dim splittedElement As Variant
For Each splittedElement In splittedElements
c.Add splittedElement
Next
Else
c.Add element
End If
Next
' print the collection to column Q
PrintToColumn c, "Q"
End Sub
Private Sub PrintToColumn(c As Collection, ByVal toColumn As String)
Application.ScreenUpdating = False
' clear the column before printing
Columns(toColumn).ClearContents
' iterate collection and print each item on a new row in the specified column
Dim element As Variant
For Each element In c
Range(toColumn & Range(toColumn & Rows.Count).End(xlUp).Row + 1) = element
Next
Application.ScreenUpdating = True
End Sub
Private Function NeedSplitting(cell As Variant) As Boolean
' returns true if the cell needs splitting
If UBound(Split(cell, "/")) > 0 Then
NeedSplitting = True
End If
End Function
After running the code all your numbers should appear as separate elements in column Q
NOTE: Why use a Collection?
Collections in VBA are dynamic. It means you don't have to know the size of a collection in order to use it - unlike arrays. You can re-dim your array multiple times to increase its size but that's rather considered a bad practice. You can add nearly as many items to a Collection as you want with a simple Collection.Add method and you don't have to worry about increasing the size manually - it's all done for you automatically. In this scenario the processing happens in memory so it should be much quicker then replacing cells contents inside a loop.
Try this:
Dim s As Integer
Dim splitted_array() As String
s = 2 'Assuming data starts at row 2
Do Until Range("N" & s).Value = vbNullString Or s >= Rows.Count
'Split the array
splitted_array = Split(Range("N" & s).Value, "/")
If UBound(splitted_array) > 0 Then
'Set the first value on the first row
Range("N" & s).Value = splitted_array(0)
For i = 1 To UBound(splitted_array)
'Add subsequent rows
Rows(s + i).Insert xlDown
Range("J" & s + i & ":O" & s + i).Value = Range("J" & s & ":O" & s).Value
Range("N" & s + i).Value = splitted_array(i)
Next
End If
s = s + 1 + UBound(splitted_array)
Loop
This code turns this:
into this:
We have a blank workbook which I would like the user to be able to paste a list of reference numbers into column A. Some of these reference numbers will have a "+" at the end.
Sub texter1()
With Sheets("texter")
ll = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To ll
If InStr(1, .Range("a" & i).Value, "+", 1) Then
.Range("b" & i).Formula = "=LEFT(A" & i & ", LEN(A" & i & ")-1)"
.Range("c" & i).Value = Sheets("texter").Range("b" & i).Value
.Range("d" & i).Formula = "=VLOOKUP($c" & i & ", _
[Current_Master.xlsm]Master!$A$3:$BB$20000,14,FALSE)"
.Range("e" & i).Formula = "=VLOOKUP($c" & i & ", _
[Current_Master.xlsm]Master!$A$3:$BB$20000,15,FALSE)"
Else
Cells(i, "a").EntireRow.Delete
End If
Next i
End With
End Sub
I would like reference numbers without the "+" to have the whole row deleted. Reference numbers with a "+" work fine.
this seems to work but has to be run multiple times for it to delete all the rows without a "+" and I cannot figure out why. Please help
Thank you
You cannot delete a row inside a loop as far as affects the iterations. Imagine this: you have 4 rows; the second row meets the conditions and is deleted; in the next iteration the counter is 3 but the row number 3 is now the fourth row (when you delete a row, all the ones below go up one position); consequently, row number 3 wouldn't be analysed. Thus the solution is simple:
Cells(i, "a").EntireRow.Clear()
If you want to actually delete the whole row, you would have to do it outside the main loop. For example: store all the rows to be deleted in an array and iterate through this array right after completing the main loop.
Another alternative would be performing the iterations in the main loop in inverse order (from maximum row to minimum one), although this option is not always applicable (not sure if in your case) and might provoke further problems. The two options above are good enough, I have mentioned this last alternative just as something worthy to be known.
--- UPDATE
To delete the rows after the main loop you can use something on these lines:
'Declaration of variables
ReDim allRows(ll + 1) As Long
Dim allRowsCount As Long: allRowsCount = 0
In your main loop you store the given rows (where you have now Cells(i, "a").EntireRow.Delete):
For i = 1 To ll
'etc.
else
allRowsCount = allRowsCount + 1
allRows(allRowsCount) = i
After the loop is completed, you go through all the stored rows (in inverse order) and delete them:
If (allRowsCount > 0) Then
Dim curRow As Long: curRow = allRowsCount + 1
Do
curRow = curRow - 1
.Rows(allRows(curRow)).Delete
Loop While (curRow > 1)
End If
End With
End Sub