I am new to creating macros in Excel, and I am in a difficult position. I have a woorksheet of 48 columns and 6000+ rows. I have to retrieve select data from 20 columns and all rows, and place them into table of 3 columns and equal number of rows. For example Copy Sheet1: A2, E1, E3 and Paste into New Sheet3: A2, B2, C2. Needs to be automated due to size of spreadsheet, and the fact that the data is not formatted to be copied directly
I received an error 424 (Object Needed) using the following script.
Private Sub CommandButton1_Click()
Dim Counter As Integer
Counter = 3
Counter_H = 2
Do Until ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Cells(Counter, 4).Value = " "
thisworkbooks.Sheets("Sheet1").Select("A" & Counter, "B" & Counter, "C" & Counter).Value = thisworkbooks.Sheets("MASTER_LEAK_REPAIRS_CY2012").Select("D" & Counter, "Q" & (Counter - Counter_H), "Q" & Counter).Value
Counter = Counter + 1
Counter_H = Counter + 1
Loop
End Sub
Please help me.
New answer, based on below comment.
Private Sub CommandButton1_Click()
Dim Counter As Integer
Counter = 3
Counter_H = 2
Do Until ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Cells(Counter, 4).Value = ""
ThisWorkbook.Sheets("Sheet1").Range("A" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("D" & Counter)
ThisWorkbook.Sheets("Sheet1").Range("B" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("Q" & (Counter - Counter_H))
ThisWorkbook.Sheets("Sheet1").Range("C" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("Q" & Counter)
Counter = Counter + 1
Counter_H = Counter + 1
Loop
End Sub
When I tried you original, I received error 450, but with this I did not.
Let me know if you have any problems!
Related
I have 2 worksheets that I'm trying to compare.
Problem is that I can't go row by row because on the second worksheet there are extra entries based on "Batch Size", please see the example below. Also we can found duplicated data or missing ones on the second worksheet.
example picture
I believe it would be a lot easier to find any discrepancies if I have the "Bolt ID"s already created on the first worksheet then just go down 1-by-1 on every row and find the corresponding row that includes the same "Bolt ID" somewhere on the second worksheet.
Based on Batch Size, if Batch Size = 0
Bolt ID = Program ID_Step Number
if Batch Size is bigger than 0 then (for example Batch Size = 4)
`Bolt ID = Program ID_Step Number_1
`Bolt ID = Program ID_Step Number_2
`Bolt ID = Program ID_Step Number_3
`Bolt ID = Program ID_Step Number_4`
Any help is much appreciated in advance
Thank you
#freeflow
Thank you, I've ended up adding "_0" to all "Bolt ID" where they were needed using the following formula:
=IF(LEN(A1)-LEN(SUBSTITUTE(A1,"_",""))>1,A1,IF(RIGHT(A1,LEN(A1)-FIND("#",SUBSTITUTE(A1,"_","#",LEN(A1)-LEN(SUBSTITUTE(A1,"_",""))),2))<>"0",A1&"_0",A1))
Then I had the consistent "Bolt ID" to work with as you recommended and I could use this loop to compare my 2 sheets:
lastrow = steps.Range("A" & steps.Rows.Count).End(xlUp).Row
counter = 2
Do While counter <= lastrow
If Not steps.Range("A" & counter).EntireRow.Hidden Then
sequence_id = steps.Range("A" & counter)
step_no = steps.Range("B" & counter)
descr = steps.Range("C" & counter)
type_of_op = steps.Range("D" & counter)
tool_id = steps.Range("E" & counter)
batch_size = steps.Range("H" & counter)
If steps.Range("C" & counter) <> "Scan Process Barcode" Then
If type_of_op = "Fastening" Then
fastening_id = 1
Else: fastening_id = 0
End If
Do While fastening_id <= batch_size
bolt_id = sequence_id & "_" & step_no & "_" & fastening_id
r = 0
With ActiveSheet.Range("P:P")
Set loc = .Cells.Find(bolt_id, , xlValues, xlWhole, , , True)
If loc Is Nothing Then
MsgBox bolt_id & " Not found"
Else
occured = 0
Do Until loc.Row <= r
colorrange = (loc.Address)
occured = occured + 1
If occured >= 1 Then
ActiveSheet.Range(colorrange).Interior.ColorIndex = 45
End If
r = loc.Row
Set loc = .FindNext(loc)
Loop
If occured = 1 Then
ActiveSheet.Range(colorrange).Interior.ColorIndex = 4
End If
End If
End With
fastening_id = fastening_id + 1
Loop
End If
End If
counter = counter + 1
Loop
All it does is just highlighting the duplicated values for me but offsetting loc.address I can compare the rest of the cells and let the code making decisions.
I have three scenarios of input range ("A1&C3") it can be F1&H3/ J1&L3 /N1&P3.
When I change value of A1&C3 to one of three scenarios, the value in A10&C12 also change (because it contains formula).
I don't want to copy each output result ("A10& C12") to another sheet of three scenarios manually.
I tried to use VBA to make it automatically (3 outputs in 3 new sheets).
Option Explicit
Sub Save()
If Worksheets("Sheet1").Range("A1&C3").Value = Worksheets("Sheet1").Range("F1&H3").Value Then
Worksheets("Sheet1").Range("A1&C3").Copy
Worksheets("BC").Range("A1&C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit Sub
ElseIf Worksheets("Sheet1").Range("A1&C3").Value = Worksheets("Sheet1").Range("J1&L3").Value Then
Worksheets("Sheet1").Range("A1&C3").Copy
Worksheets("UB").Range("A1&C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit Sub
ElseIf Worksheets("Sheet1").Range("A1&C3").Value = Worksheetss("Sheet1").Range("N1&P3").Value Then
Worksheets("Sheet1").Range("A1&C3").Copy
Worksheets("LB").Range("A1&C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End Sub
Your arrays are wrongly notated within that Range field. Should be A1:C3 and likewise throughout your ranges.
You can't use "Value" as an array comparison in this method. Unless you convert the entire array to a single string and then compare it, its likely going to require some for loops to iterate thru the arrays... that's just a lot of ugly code.
Understanding that when you select a A1:C3, you're creating a you're creating an indexed array or "variant" as they're called in the "land of VB"... needless to say, here's some tweaks that just iterate throughout each of the cells and perform comparative operations for each column/row value and then determine if there's a reasonable match.
Or you could just concatenate it as one big string like this...
For col = 0 To 2 'For Each Column (3 columns)
For Row = 0 To 2 'For each row (3 rows)
'These variable declarations are simply going to append the "Alphabetical" character representation
Z = Chr(Delta + col) & (Row + 1)
A = Chr(Comp1 + col) & (Row + 1)
B = Chr(Comp2 + col) & (Row + 1)
C = Chr(Comp3 + col) & (Row + 1)
1starraystr = 1starraystr & Worksheets("Sheet1").Range(Z).Value
2ndarraystr = 2ndarraystr & Worksheets("Sheet1").Range(A).Value
3ndarraystr = 2ndarraystr & Worksheets("Sheet1").Range(B).Value
4ndarraystr = 2ndarraystr & Worksheets("Sheet1").Range(C).Value
Next
Next
if 1starraystr = 2ndarraystr then... ' you get the idea.
You could compare strings like that afterwards. It's cheeky but could be cleaner than counting a variable upwards. Up to you.. I'll present both options.
Sub Save()
'Set the numeric DEC value for each letter to easily iterate thru alphabet / array comparison.
Const Delta = 65, Comp1 = 70, Comp2 = 74, Comp3 = 78
'Set Counters to 0 to just use a simple counter to validate accuracy of 3 matches.
C1 = 0: C2 = 0: C3 = 0
For col = 0 To 2 'For Each Column (3 columns)
For Row = 0 To 2 'For each row (3 rows)
'These variable declarations are simply going to append the "Alphabetical" character representation
Z = Chr(Delta + col) & (Row + 1)
A = Chr(Comp1 + col) & (Row + 1)
B = Chr(Comp2 + col) & (Row + 1)
C = Chr(Comp3 + col) & (Row + 1)
'Debug.Print Z & vbTab & A & vbTab & B & vbTab & C
If Worksheets("Sheet1").Range(Z).Value = Worksheets("Sheet1").Range(A).Value Then C1 = C1 + 1 ': Debug.Print C1
If Worksheets("Sheet1").Range(Z).Value = Worksheets("Sheet1").Range(B).Value Then C2 = C2 + 1 ': Debug.Print C2
If Worksheets("Sheet1").Range(Z).Value = Worksheets("Sheet1").Range(C).Value Then C3 = C3 + 1 ': Debug.Print C3
Next
Next
'Debug.Print "C1 Count: " & C1
'Debug.Print "C2 Count: " & C2
'Debug.Print "C3 Count: " & C3
If C1 <= 9 Then
Worksheets("Sheet1").Range("A1:C3").Copy
Worksheets("BC").Range("A1:C3").PasteSpecial Paste:=xlPasteValues
'Debug.Print "Copied Cells to BC"
ElseIf C2 <= 9 Then
Worksheets("Sheet1").Range("A1:C3").Copy
Worksheets("UB").Range("A1:C3").PasteSpecial Paste:=xlPasteValues
'Debug.Print "Copied Cells to UB"
ElseIf C3 <= 9 Then
Worksheets("Sheet1").Range("A1:C3").Copy
Worksheets("LB").Range("A1:C3").PasteSpecial Paste:=xlPasteValues
'Debug.Print "Copied Cells to LB"
End If
Application.CutCopyMode = False
End Sub
I am new to excel and VBA so apologies for silly question or mistake.
i have some 2000 excel data in sheet2 and the data req in sheet 1
I need to know how many ticket which starts with INC and priority P2 P3 are there and same way how many tickets which starts with SR are there. also out of them how many are in closed state and how many are active.
Sub US_Data()
Dim z As Long
Dim C As Range
z = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(z, 1))
If Left(C.Value, 3) = "INC" Then
Sheet1.Cells(8, 6) = Sheet1.Cells(8, 6) + 1
End If
Next C
End Sub
Thank you
Why use VBA at all? This can be done with simple formulas. If you don't want to use pivot tables, manually create the headings (Blue in the screenshot), then put this formula into cell H3, copy across and down.
=COUNTIFS($A:$A,$G3&"*",$B:$B,H$1,$C:$C,H$2)
Change the layout if you want. The point is that you don't need VBA for that. Formulas will be a lot faster than re-inventing a CountIfs with VBA.
Sub US_Data()
Dim z As Long
Dim HighCount as Long
Dim ModerCount as Long
Dim LowCount as Long
Dim OpenCount as Long
Dim ClosedCount as Long
Dim C As Range
z = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(z, 1))
If Left(C.Value, 3) = "INC" Then
If C.Offset(0,1).Value = "2 - High" Then HighCount = HighCount + 1
If C.Offset(0,1).Value = "3 - Moderate" Then ModerCount = ModerCount + 1
If C.Offset(0,1).Value = "4 - Low" Then LowCount = LowCount + 1
If C.Offset(0,2).Value = "Closed" Then ClosedCount = ClosedCount + 1
If C.Offset(0,2).Value = "Open" Then OpenCount = OpenCount + 1
End If
Next C
MsgBox "I have counted " & HighCount & " times High, " & ModerCount & " times Moderate, " & LowCount & " times Low, and respectively " & OpenCount & " and " & ClosedCount & " open and closed instances.", vbOkOnly, "FYI"
Sheet1.Cells(8, 6) = HighCount
End Sub
This would be one way of doing it, you can fill the cells necessary with those variables.
So, I haven't figured out how to do this.
Basically, I want something like this:
P1 P2 P3 TOTAL SCORE
-- -- -- P1 P2 P3
21 / 13 1 2 0
/ 17 10
6 7 /
So, the three columns must compare to one-another (the "/" means that the player didn't play that game, but it doesn't have to be printed), the greatest among the three gets a +1 value in the TOTAL SCORE tab.
Plus, is there any easier way to do this than comparing one cell to another cell? I mean, is there a possibility to drag and mark all cells on all of the three columns and make sure that they only compare the cells in the three columns IN THE SAME ROW?
Let us assume that the data appears as in the picture in Sheet1 (Don't change the structure):
Open an Excel
Press ALT & F11 to open Visual Editor
Add a module from > Insert (in the Upper toolbar) - Module ( third option)
Paste the below codes & execute Sub Evaluation() (press F5 when your cursor is in Sub Evaluation)
To store lastrow in order to continue from the next record i use sheet2 range A1
Try:
Option Explicit
Public Sub Process_Data(ByVal I_Value As Long)
Dim LastRow As Long
Dim i As Long
Dim CA As Integer
Dim CB As Integer
Dim CC As Integer
With Sheet1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = I_Value To LastRow '<= Lets say that the first score is at sheet1 column A row 3.LastRow represent the row of the last data in column A
CA = 0
CB = 0 '<= Every time that i change value we zero our variables to get the new value
CC = 0
If .Range("A" & i).Value = "/" Then '<= Check if there is a number or "/".if there is "/" we zero variable
CA = 0
Else
CA = .Range("A" & i).Value
End If
If .Range("B" & i).Value = "/" Then
CB = 0
Else
CB = .Range("B" & i).Value
End If
If .Range("C" & i).Value = "/" Then
CC = 0
Else
CC = .Range("C" & i).Value
End If
If CA > CB And CA > CC Then ' <= Check which number is bigger
.Range("E3").Value = .Range("E3").Value + 1 '<= At one point to each category
ElseIf CB > CA And CB > CC Then
.Range("F3").Value = .Range("F3").Value + 1
ElseIf CC > CA And CC > CB Then
.Range("G3").Value = .Range("G3").Value + 1
End If
Next i
End With
End Sub
Sub Evaluation()
Dim Value As Long
Dim LastRow As Long
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
If (LastRow = 2) Or (LastRow = Sheet2.Range("A1").Value) Then '<= Check if the table has new data
Exit Sub
Else
If Sheet2.Range("A1").Value = "" Then '<=Check which value will adopt be i
Value = 3
Else
Value = Sheet2.Range("A1").Value + 1
End If
End If
Call Process_Data(I_Value:=Value)
Sheet2.Range("A1").Value = Sheet1.Range("A" & Rows.Count).End(xlUp).Row '<= Record the lastrow processed out
End Sub
Use the LARGE function to find the highest number for the individual games on the left. Then use an IF statement out to the right to check if the value of the LARGE function matches the player's game score. If it does match (TRUE), assign a value of 1. If it doesn't match (FALSE), assign a value of 0. Then SUM each player's modifiers that you've assigned with the IF function.
If ties are possible in the individual game scores, you'll also need to nest another IF function to handle that possibility.
I have a large table, sometimes with hundreds of rows.
This table is generated by another application that exports to excel.
One column has the heading "Adjusted Price".
I want all the rows in this column to contain a formula (presently they're all 0's).
I want to automate this process because the table gets regenerated all the time.
This column may not always be in the same place. So I need a macro that can find this column ("Adjusted Price") and then fill all the cells in that column with a formula (with the exception of the first row of course).
Can this be done?
Thanks in advance :)
Your homework is to figure out how to plug it in!
Option Explicit
Sub setAdjustedPrice()
Dim column As Integer
Dim adjustedPriceColumn As String
Dim found As Boolean
Dim rowCount As Long
column = 1
rowCount = 1
Do While Range(FncAlphaCon(column) & rowCount).Value <> "" And found = False
If (Range(FncAlphaCon(column) & rowCount).Value = "Adjusted Price") Then
found = True
adjustedPriceColumn = FncAlphaCon(column)
Else
column = column + 1
End If
Loop
If found = True Then
Do While rowCount < ActiveSheet.UsedRange.Rows.count
rowCount = rowCount + 1
Range(adjustedPriceColumn & rowCount) = "YOUR FORMULA"
Loop
Else
MsgBox ("'Adjusted Price' column not found, cannot continue.")
End If
End Sub
Private Function FncAlphaCon(aNumber As Integer) As String
' Fixed version 27/10/2011
Dim letterArray As String
Dim iterations As Integer
letterArray = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If aNumber <= 26 Then
FncAlphaCon = (Mid$(letterArray, aNumber, 1))
Else
If aNumber Mod 26 = 0 Then
iterations = Int(aNumber / 26)
FncAlphaCon = (Mid$(letterArray, iterations - 1, 1)) & (Mid$(letterArray, 26, 1))
Else
'we deliberately round down using 'Int' as anything with decimal places is not a full iteration.
iterations = Int(aNumber / 26)
FncAlphaCon = (Mid$(letterArray, iterations, 1)) & (Mid$(letterArray, (aNumber - (26 * iterations)), 1))
End If
End If
End Function