i have 2 sheets , i want to find the same rows in 2 sheets , so i put the first row in array , and by a for next i define the first array ...then i define another array from second sheet , then i compare them .... why it doesn't work?
Sub compare()
Dim n(4) As Variant
Dim o(4) As Variant
Dim i As Integer
For i = 3 To 20 'satrha
For j = 2 To 4 'por kardan
n(j) = Sheets("guys").Cells(i, j)
Next 'por kardan
k = 3
Do 'hhhh
For Z = 2 To 4 'por dovomi
o(Z) = Sheets("p").Cells(k, Z)
Next 'por dovomi
If n(j) = o(Z) Then
Sheets("guys").Cells(i, 1) = Sheets("p").Cells(k, 2)
flag = True
Else
flag = False
k = k + 1
End If
Loop Until flag = False 'hhhhh
Next 'satrha
End Sub
Guessing from your existing code, my following code will copy the value from sheet "p" column B into sheet "guys" column A when a match is found.
Sub compare()
Dim i As Integer
Dim j As Integer
Dim l As Integer
l = Sheets("p").Range("B65535").End(xlUp).Row
Debug.Print l
For i = 3 To 20
For j = 3 To l
If Sheets("guys").Cells(i, 2).Value = Sheets("p").Cells(j, 2).Value And _
Sheets("guys").Cells(i, 3).Value = Sheets("p").Cells(j, 3).Value And _
Sheets("guys").Cells(i, 4).Value = Sheets("p").Cells(j, 4).Value Then
Sheets("guys").Cells(i, 1).Value = Sheets("p").Cells(j, 2).Value
Exit For
End If
Next
Next
End Sub
Noted that I explicitly said Value in my code. That will copy the computed value (e.g. result of a formula) instead of the "original" content.
Related
I'm trying to clean up raw data exported from an online database.
There can be up to five columns. If all cells in a row have a value of 0, I want to delete that row.
When the user exports the data, they can choose to exclude columns, and the columns can be in any order.
For example, if the data contains only two of the possible five columns, I want to check just those two for 0s.
Could do a a big loop looking at every row and seeing if all 5 columns in that row are blank
Sub test()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("sheetname")
Dim LastRow As Integer
LastRow = sh.UsedRange.Rows.Count - 1
For i = 1 To LastRow
If (sh.Cells(i, 1).Value = "" And sh.Cells(i, 2).Value = "" And sh.Cells(i, 3).Value = "" And _
sh.Cells(i, 4).Value = "" And sh.Cells(i, 5).Value = "") Then
sh.Cells(i, 1).EntireRow.Delete
i = i - 1
Dim newLastRow As Integer
newLastRow = sh.UsedRange.Rows.Count - 1
If i = newLastRow Then
Exit For
End If
End If
Next i
MsgBox ("Done")
End Sub
#kyle campbell, thank you for your input! It didn't quite get me there, but it did get my wheels turning. Here is the solution I came up with, if anyone's curious:
I set a variable to represent the column number for each of the 5 possible columns using Range.Find. If the Find came up with nothing, I set the variable to 49, since the maximum number of columns this report can have is 48.
Then I did a nested If to test if the value in each cell was either 0 or null (because if the column number is 49, there won't be any data there). If all Ifs were true, I deleted the row. I also added a counter and message box, just to make sure this worked.
Sub DeleteRows()
Dim O As Long
Dim E As Long
Dim H As Long
Dim B As Long
Dim P As Long
lRow = Range("A1").CurrentRegion.Rows.Count
If Range("1:1").Find("SUM(OBLIGATIONS)") Is Nothing Then
O = 49
Else
O = Range("1:1").Find("SUM(OBLIGATIONS)").Column
End If
If Range("1:1").Find("SUM(EXPENDITURES)") Is Nothing Then
E = 49
Else
E = Range("1:1").Find("SUM(EXPENDITURES)").Column
End If
If Range("1:1").Find("SUM(HOURS)") Is Nothing Then
H = 49
Else
H = Range("1:1").Find("SUM(HOURS)").Column
End If
If Range("1:1").Find("SUM(BUDGET_RESOURCES)") Is Nothing Then
B = 49
Else
B = Range("1:1").Find("SUM(BUDGET_RESOURCES)").Column
End If
If Range("1:1").Find("SUM(PRIOR_YEAR_RECOVERY)") Is Nothing Then
P = 49
Else
P = Range("1:1").Find("SUM(PRIOR_YEAR_RECOVERY)").Column
End If
Dim j As Integer
j = 0
For i = lRow To 2 Step -1
If Cells(i, O) = 0 Or Cells(i, O) = "" Then
If Cells(i, E) = 0 Or Cells(i, E) = "" Then
If Cells(i, H) = 0 Or Cells(i, H) = "" Then
If Cells(i, B) = 0 Or Cells(i, B) = "" Then
If Cells(i, P) = 0 Or Cells(i, P) = "" Then
Rows(i).Delete
j = j + 1
End If
End If
End If
End If
End If
Next i
MsgBox "Macro complete, " & j & " lines deleted."
End Sub
Trying to loop through a sheets"data".Range"AM1:AS12" and copy the data to range beginning at BD1 as long as the data doesn't equal "#N/A"
My code works with copying the first column, but doesn't do anything with the data after that. Where am I going wrong?
Set S2 = Sheets("data").Range("AM:AM")
Set S3 = Sheets("data").Range("BD:BD")
Dim i As Integer, j As Integer
j = 1
For i = 1 To 12
If S2.Cells(i, 1).Value <> "#N/A" Then
S3.Cells(j, 2).Value = S2.Cells(i, 1).Value
j = j + 1
End If
Next i
Replace:
<> "#N/A"
By:
Not(Application.WorksheetFunction.IfNa(...))
This works when i tested it.
Sub CopyCell()
Set S2 = Sheets("data").Range("A:A")
Set S3 = Sheets("data").Range("M:M")
Dim i As Integer, j As Integer
For j = 1 To 2
For i = 1 To 12
If S2.Cells(i, j).Value <> "#N/A" Then
S3.Cells(i, j).Value = S2.Cells(i, j).Value
End If
Next i
Next j
Call DeleteBlank
End Sub
Sub DeleteBlank()
Dim x As Integer
Dim y As Integer
For y = 13 To 16 'Range numbers for the columns the data is copied to
For x = 1 To 10 ' Number of cells of data you want to loop through
If Cells(x, y).Value = "" Then
Cells(x, y).Delete Shift:=xlUp
End If
Next x
Next y
End Sub
the best thing to is not to check if it is equal to "#N/A"
The best is to check if it is an error : If Not (IsError(S2.Cells(i, 1).Value)) Then
I'm trying to write code that extracts X consecutive numbers from text.
For example, if I want to extract 5 consecutive numbers in my text:
Cell A1: dsuad28d2hr 22222222 11111 d33d11103
Cell B2: 11111 (wanted)
I could make it work for texts with only 5 numbers but the problem is if my text contains other consecutive numbers higher than 5.
Sub ExtractNum2()
Dim Caract() As String
Dim i As Integer
Dim j As Integer
Dim z As Integer
Dim cont As Integer
Dim goal As Integer
Dim Protocolo() As String
Dim cel As String
Dim lin As Long
lin = Range("A1", Range("A1").End(xlDown)).Rows.Count 'Repeat for each line
For z = 1 To lin
cel = Cells(z, 1)
ReDim Caract(Len(cel))
ReDim Protocolo(Len(cel))
cont = 0
For i = 1 To Len(cel)
Caract(i) = Left(Mid(cel, i), 1)
If IsNumeric(Caract(i)) Then 'Character check
cont = cont + 1
Protocolo(cont) = Caract(i)
'If Not IsNumeric(Caract(6)) And cont = 5 Then**
If cont = 5 '
Dim msg As String
For j = 1 To 5
msg = msg & Protocolo(j)
Next j
Cells(z, 2) = msg 'fills column B
msg = ""
End If
Else
cont = 0
End If
Next i
Next z 'end repeat
End Sub
I'm trying to use:
If Not IsNumeric(Caract(6)) And cont = 5 Then
But it is not working, my output is: B2: 22222 but I want 11111.
What am I missing?
EDIT
Sorry i wasnt clear. I want to extract X numbers with 6>x>4 (x=5). I dont want 22222 since it has 8 consecutive numbers and 11111 has 5 in my example.
UDF:
Function GetNum(cell)
With CreateObject("VBScript.RegExp")
.Pattern = "\b(\d{5})\b"
With .Execute(cell)
If .Count > 0 Then GetNum = .Item(0).SubMatches(0)
End With
End With
End Function
UPDATE:
If you want to return error (say, #N/A) instead of callee's default data type, you could write the following:
Function GetNum(cell)
With CreateObject("VBScript.RegExp")
.Pattern = "\b(\d{5})\b"
With .Execute(cell)
If .Count > 0 Then
GetNum = .Item(0).SubMatches(0)
Else
GetNum = CVErr(xlErrNA)
End If
End With
End With
End Function
I tried this with a Cell containing "Yjuj 525211111x5333332s5" to test whether 2 consecutive 5 characters get catch, and it worked great.
Sub Macro_Find_Five()
Dim str As String
Dim tmp As String
Dim cntr As Integer
Dim result As String
str = Sheet1.Cells(1, 1).Value
tmp = ""
cntr = 1
col = 2
result = ""
'For Loop for tracing each charater
For i = 1 To Len(str)
'Ignore first starting character
If i > 1 Then
'If the last character matches current character then
'enter the if condition
If tmp = Mid(str, i, 1) Then
'concatenate current character to a result variable
result = result + Mid(str, i, 1)
'increment the counter
cntr = cntr + 1
Else
'if the previous character does not match
'reset the cntr to 1
cntr = 1
'as well initialize the result string to "" (blank)
result = ""
End If
End If
'if cntr matches 5 i.e. 5 characters traced enter if condition
If cntr = 5 Then
'adding to next column the result found 5 characters same
Sheet1.Cells(1, col).Value = result
'increment the col (so next time it saves in next column)
col = col + 1
'initializing the variables for new search
cntr = 1
tmp = ""
result = ""
End If
'stores the last character
tmp = Mid(str, i, 1)
'if first character match concatenate.
If cntr = 1 Then
result = result + Mid(str, i, 1)
End If
Next i
End Sub
i'm currently trying to compare each and every cell in a column with each other in order to find duplicates. I wrote below code, i know it as possible via default Excel functions, but i would like to write a macro with the above mentioned function. Excel currently doesn't respond when i run my code, my guess is that i run a double for loop with 14K cells to compare is each resulting in 14.000*14.000 loops, which is kinda unhandy. Any help will be appreciated :).
Sub findidentical()
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim ColumnG As Integer
x = 0
ColumnG = Application.WorksheetFunction.CountA(Range("G:G"))
'ColumnG is 14K cells long'
For i = 2 To ColumnG
For j = 1 + 1 To ColumnG
If Cells(i, 7).Value = Cells(j, 7).Value Then
x = x + 1 & Cells(i, 7).Font.Bold = True & Cells(j, 7).Font.Bold = True
End If
Next j
Next i
Range("L25").Text = "Amount of duplicates"
Range("L26").Value = x
End Sub
Try this:
Sub findidentical()
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim ColumnG As Integer
x = 0
ColumnG = Application.WorksheetFunction.CountA(Range("G:G"))
'ColumnG is 14K cells long'
For i = 2 To ColumnG
For j = i + 1 To ColumnG
If Cells(i, 7).Value = Cells(j, 7).Value Then
x = x + 1
Cells(i, 7).Font.Bold = True
Cells(j, 7).Font.Bold = True
End If
Next j
Next i
Range("L25").Text = "Amount of duplicates"
Range("L26").Value = x
End Sub
First you need to make each command in the if statement its own line or separate them with : instead of &. & is a string concatenation not a command separator.
Second there is no reason to start Loop j at 2 it has already been compared to everything above. So start it at i+1
How to compare two list of values A and B, if there any value in B equals to a value in the list A, Then write the row number of the column A in front of the value in the column B using Excel/macro/VBA.
Use this VBA:
Sub Test()
Dim ws As Worksheet
Dim i As Long, j As Long, k As Long
Dim strValueB As String, strValueA As String
Set ws = ActiveSheet
Do
i = i + 1: j = 0
strValueB = ws.Cells(i, 2).Value '2 -> Column B
If (strValueB = "") Then Exit Do
Do
j = j + 1
strValueA = ws.Cells(j, 1).Value '1 -> Column A
If (strValueA = "") Then
k = 0
Exit Do
ElseIf (strValueB = strValueA) Then
k = j
Exit Do
End If
Loop
If (k > 0) Then
ws.Cells(i, 3).Value = k '3-> Column C
End If
Loop
End Sub
You want to use the following formula
= MATCH(ListAVariable, $B:$B:,0)
Put this in Column C - then use
=CONCATENATE(BX, " ", CX)
In column D