I am having a little trouble figuring out a macro to help me with some of my data. I have come across a couple macro's that almost do what I need, but I don't know enough about the language yet to figure it out. This is what I am working with.
Column A - List of software.
Column B - Version of software.
Column C - Computer names it is installed on.
What I am looking for. I need a macro to search for duplicates that match both Column A and B. If it has a duplicate, I need it to copy the duplicates and original rows to Sheet2.
Now Sheet2 should only have duplicate items on it. Would it be possible to search for duplicates again (Column A&B), when it gets a match, JoinRange of the Column C's together. Then delete the duplcates.
Ex:
Column A (Software)
Adobe Reader X
Adobe Reader X
Adobe Reader X
Adobe Reader XI
Adobe Reader XI
Column B (Version)
10.1.6
10.1.6
10.1.7
11.0.03
11.0.03
Column C (Computers)
Computer1,Computer2
Computer3,Computer4
Computer5,Computer6
Computer7,Computer8
Computer9,Computer10
Finished product would be:
Column A
Adobe Reader X
Adobe Reader X
Adobe Reader XI
Column B
10.1.6
10.1.7
11.0.03
Column C
Computer1,Computer2,Computer3,Computer4
Computer5,Computer6
Computer7,Computer8,Computer9,Computer10
I'm not sure if this is possible, but I could sure use some guidance.
V/r,
Brett
Pretty simple. Add a sheet called "Duplicates", then select the sheet you want to check for duplicates, then make sure the sheet is sorted first by col A next by Col B, then run this macro:
Sub GetDuplicates()
On Error GoTo errGetDuplicates
d = 1
x = 1
Do Until Cells(x, 1) = "" 'Looks at each row until it reaches the end
If Cells(x, 1) = Cells(x + 1, 1) Then 'Checks Col 1 for duplicates
If Cells(x, 2) = Cells(x + 1, 2) Then 'Checks Col 2 for duplicates
Sheets("Duplicates").Cells(d, 1) = Cells(x, 1)
Sheets("Duplicates").Cells(d, 2) = Cells(x, 2)
Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
d = d + 1
x = x + 1
Sheets("Duplicates").Cells(d, 1) = Cells(x, 1)
Sheets("Duplicates").Cells(d, 2) = Cells(x, 2)
Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
d = d + 1
End If
End If
doneWithError:
x = x + 1
Loop
Exit Sub
errGetDuplicates:
If Err = 1004 Then
array1 = Split(Cells(x, 1), " ")
array2 = Split(Cells(x + 1, 1), " ")
For a = 0 To UBound(array1)
If Not array1(a) = array2(a) Then GoTo unmatched
Next a
array3 = Split(Cells(x, 2), " ")
array4 = Split(Cells(x + 1, 2), " ")
For a = 0 To UBound(array1)
If Not array3(a) = array4(a) Then GoTo unmatched
Next a
Sheets("Duplicates").Cells(d, 1) = Join(array1, " ")
Sheets("Duplicates").Cells(d, 2) = Join(array3, " ")
Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
d = d + 1
x = x + 1
Sheets("Duplicates").Cells(d, 1) = Join(array2, " ")
Sheets("Duplicates").Cells(d, 2) = Join(array4, " ")
Sheets("Duplicates").Cells(d, 3) = Cells(x, 3)
d = d + 1
GoTo doneWithError
End If
End Sub
Related
I currently have a worksheet that allows the end user to select from a set of districts and have subdistricts populate along with their vote strength. For instance
District = 5
Candidates = 3
Subdistricts
Subdistrict Vote Strength
U 456
E 442
R 876
T 312
B 256
S 643
I'd like to create a button that let's an end user create an additional sheet that will populate based off of the values in their district selection. The newly created sheet would create a "ballot" of sorts. On the first sheet, they'd indicated the number of candidates and the new sheet would populate similar to this
U E R T B S
Candidate 1
Candidate 2
Candidate 3
The end user would input raw vote (a number between 0 and 4), which would be multiplied by the vote strength in sheet 1, producing a weighted vote calculator that scales up or down depending on the number of subdistricts a certain district has.
The logic would essentially be:
Create a new sheet
Horizontally add column headers for each subdistrict in sheet 1 and add rows for total number of candidates in sheet 1
As raw votes are entered, a mirrored table from the table created in sheet 2 is produced with raw vote calculated
Updated the loop to show the formula instead:
For m = 2 To i + 2
Cells(CandidateCount + 1, m).Formula = _
"=SUM(" & ActiveSheet.Range(ActiveSheet.Cells(2, m), ActiveSheet.Cells(CandidateStart, m)).Address(False, False) & ")"
Next m
So thanks to #VBA Pete for putting me on the right track, I managed to create the basic functionality. I'm now stuck on this step
As raw votes are entered, a mirrored table from the table created in sheet 2 is produced with raw vote calculated
I need to accomplish two things one more step:
1. Create a data validation requirement in a For Loop for a column range that disallows more raw votes being counted than people who are actually present. I have this stored in a variable in the code below as MembersPresent.
2. Populate the weighted vote after end user input is recorded. This can be accomplished by inserting a dynamic formula into cells inside a For loop using variables. I've seperated the working code from the non-working code below
Private Sub CommandButton1_Click()
ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
i = Sheet1.Cells(8, 6).Value
CandidateCount = Sheet1.Cells(11, 8).Value
CandidateState = CandidateCount + 1
SheetName = Sheet1.Cells(13, 8).Value
OrSheetName = Sheet1.Cells(13, 8).Value
v = 0
For Each Sheet In Worksheets
If SheetName = Sheet.Name Then
SheetName = OrSheetName & "_Ballot" & v
v = v + 1
End If
Next Sheet
ActiveSheet.Name = SheetName
For x = 1 To i
b = 15 + x
Subdistrict = Cells(b, 2).Value
MembersPresent = Cells(b, 6).Value
ActiveSheet.Cells(1, (x + 1)).Value = Subdistrict
For a = 2 To 6
ActiveSheet.Cells(a, x + 1).Value = 0
With ActiveSheet.Range(ActiveSheet.Cells(a, x + 1), ActiveSheet.Cells(a, x + 1)).Validation
.Add Type:=xlValidateWholeNumber, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="0", Formula2:=MembersPresent
.InputTitle = "Integers"
.ErrorTitle = "Integers"
.InputMessage = "Enter an integer from 0 to " & MembersPresent
.ErrorMessage = "You must enter a number no less than 0 and no greater than the number of members in attendance: " & MembersPresent
End With
Next a
Next x
For b = 1 To CandidateCount
Named = "Candidate Name" & " " & b
ActiveSheet.Cells((b + 1), 1).Value = Named
Next b
ActiveSheet.Cells(CandidateCount + 1, 1).Value = "Raw Vote Totals"
Broken Code that looks like what I think I want
For m = 2 To i + 2
SumRange = ActiveSheet.Range(ActiveSheet.Cells(2, m), ActiveSheet.Cells(CandidateStart, m)).Select
ActiveSheet.Cells(CandidateCount + 1, m).Formula = "=SUM(" & SumRange & ")"
Next m
I have a great problem. I have a macro that does not run since the last week and I do not know why? I'm getting always the error: "Runtime Error 9 ...."
I know there must be a problem with the renames or arrays but I do not find anything.
Could you please check this code, maybe you can find the problem.
Thanks in advance!
Regards, Krisztian
It is just a part of the big macro.
The error is in the 8th row when "k" would be = "10"
Ubound is teoretically "9" (??)
EditRow(k) = EditRow(k) + (insdels * (k - 1))
'Populate input sheet
insdels = 0
For i = 1 To UBound(EditRow)
If FAT_Blocks(i).Range_Name <> "Absent_from_BCM" Then ' only process the blocks that were present
k = FAT_Blocks(i).GPI_Block_Number 'ERROR***************************************************************************
EditRow(k) = EditRow(k) + (insdels * (k - 1))
For m = 1 To FAT_Blocks(i).Rows
If FAT_Blocks(i).Data(m, 1) <> 0 Then ' ignore rows with zero cost/revenue in year 1
If GPIsheet.Cells(EditRow(k), 2).Interior.ColorIndex <> new_CI Then
new_InsDel (1)
insdels = insdels + 1
EditRow(k) = EditRow(k) + (k - 1)
End If
If FAT_Blocks(i).Row_Title(m) Like "*One Time*" Then
y = 0
ElseIf FAT_Blocks(i).Row_Title(m) Like "*Recurring*" Then
y = 1
Else
y = 2
End If
With GPIsheet
.Range("Original_Import_Data").Offset(EditRow(k) - 1, 0).ClearContents ' clear any mung before updating
' fill the "new_CI" coloured cells on the left
.Cells(EditRow(k), 2).value = BCMid & " " & FAT_Blocks(i).Row_Title(m) ' row description
.Cells(EditRow(k), 3).value = FAT_Blocks(i).Data(m, 1) ' unit value
.Cells(EditRow(k), 4).value = change_pc(y) ' change %
.Cells(EditRow(k), 5).value = change_year(y) ' change year
.Cells(EditRow(k), 6).value = vol_driver(y) ' volume driver
' fill the grey stuff on the right
With .Range("Original_Import_Data").Offset(EditRow(k) - 1, 0)
.Cells(1, 1) = yr ' Contract length
.Cells(1, 2) = BCMid ' BCM unique id
For j = 1 To yr
.Cells(1, 2 + j) = FAT_Blocks(i).Data(m, j) ' data for corresponding year
Next
End With
End With
EditRow(k) = EditRow(k) + 1
End If
Next m
End If
Next i
I wrote a quick script to sum everything in column E if everything is equal in column A, C, and D. I am getting an error and the actual sum function isn't working. Do you know why this would be happeing?
For i = 36 To 714 Step 1
Count = 0
If Cells(i, 7) <> 1 Then
x = i + 1
Do While x <> 714
Count = Cells(i, 5)
If Cells(i, 1) = Cells(x, 1) And Cells(i, 3) = Cells(x, 3) And Cells(i, 4) = Cells(x, 4) Then
Cells(x, 7) = 1
Count = Count + Cells(x, 5)
End If
x = x + 1
Loop
Cells(i, 6) = Count
End If
Next
As long as i reaches 714, x becomes 715 which is not equal to 714 and then do while loop stuck with eternal x. Use <= instead.
I am using a barcode scanner to do inventory with large quantities and I want to enter the data into excel. I can change the way that the scanner behaves after each scan to do things like tab, return, etc. but my big problem is that in order to efficiently provide the quantity I have to scan the item code (7 digits) and then scan the quantities from 0 to 9 in succession. Such that 548 is really 5, 4, 8 and when using excel it puts each number into a new cell. What I would like to do, but don't have the VBA chops to do it is to have excel check to see if the length is 7 digits or one digit. For each one digit number it should move the number to the next cell in the same row as the previous 7 digit number such that each successive one digit number is combined as if excel were concatenating the cells. Then it should delete the single digits in the original column and have the next row start with the 7 digit barcode number.
I hope this makes sense.
Example:
7777777
3
4
5
7777778
4
5
6
7777779
7
8
9
Should become:
| 7777777 | 345 |
| 7777778 | 456 |
| 7777779 | 789 |
Thanks!!
I set up my worksheet like this:
then ran the below code
Sub Digits()
Application.ScreenUpdating = False
Dim i&, r As Range, j&
With Columns("B:B")
.ClearContents
.NumberFormat = "#"
End With
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Set r = Cells(i, 1)
If Len(r) = 7 Then
j = 1
Do Until ((Len(r.Offset(j, 0).Text) = 7) Or (IsEmpty(r.Offset(j, 0))))
Cells(i, 2) = CStr(Cells(i, 2).Value) & CStr(r.Offset(j, 0))
j = j + 1
Loop
End If
Set r = Nothing
Next
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Len(Cells(i, 1)) < 7 Then Rows(i & ":" & i).Delete
Next i
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
and the results Ive got:
This is what I did with what you started but I think your newer solution will work better. Thank you so much mehow!
Sub Digits()
Application.ScreenUpdating = False
Dim i, arr, r As Range
Dim a, b, c, d, e
Dim y
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Set r = Cells(i, 1)
Set a = Cells(i + 1, 1)
Set b = Cells(i + 2, 1)
Set c = Cells(i + 3, 1)
Set d = Cells(i + 4, 1)
Set e = Cells(i + 5, 1)
If Len(a) = 7 Then
y = 0
ElseIf Len(b) = 7 Then
y = 1
ElseIf Len(c) = 7 Then
y = 2
ElseIf Len(d) = 7 Then
y = 3
ElseIf Len(e) = 7 Then
y = 4
Else:
y = 0
End If
If Len(r) = 7 Then
arr = Range("A" & i & ":A" & i + y).Value
Range("B" & i & ":F" & i) = WorksheetFunction.Transpose(arr)
End If
Next
Cells.Replace "#N/A", "", xlWhole
Application.ScreenUpdating = True
End Sub
Need to print a table of any numbers using VBA in excel. i.e blank row after each row . Below iswhat i wrote to print a table in consecutive rows, But i dont know how can i print the result in alternate rows?
Sub table()
a = InputBox("Enter first no")
ActiveSheet.Cells.Clear
ActiveSheet.Cells(5, 4) = "TABLE OF " & a
For i = 1 To 10
c = a * i
ActiveSheet.Cells(i + 5, 4) = a
ActiveSheet.Cells(i + 5, 5) = "*"
ActiveSheet.Cells(i + 5, 6) = i
ActiveSheet.Cells(i + 5, 7) = "="
ActiveSheet.Cells(i + 5, 8).Value = c
next i
End Sub
Sub table()
a = InputBox("Enter first no")
n As Integer
n=6
ActiveSheet.Cells.Clear
ActiveSheet.Cells(5, 4) = "TABLE OF " & a
For i = 1 To 10
c = a * i
ActiveSheet.Cells(n, 4) = a
ActiveSheet.Cells(n, 5) = "*"
ActiveSheet.Cells(n, 6) = i
ActiveSheet.Cells(n, 7) = "="
ActiveSheet.Cells(n, 8).Value = c
n = n + 2
next i
End Sub
Change your row number calculation from
i + 5
to
(i * 2) + 4