What I have until now:
The code below scans 2 sheets and checks if the same cells have identical values.If not , highlights the cell that has the discrepancy of the first sheet.
What I need extra:
I have to compare the common rows between two Files(nd not sheets),through a numbering in the first column of every file.
So, If the first cell(A column) of a row in the first file has the number "256" in it, the code has to find in the second file the row with the "256" number in its first cell(A column) and then compare the cells of the two rows for discrepancies.
If there is no such a row in the second file(meaning if there is not the number 256 in any of the cells of the first column) , the code creates in a cell an entry with an error message.
Here is an image that explains, with an example, what I need as an extra .
Below is the code where I am stuck:
EDIT:
I found and post a piece of code that checks the first column of both sheets for missing values. It works perfect but I cannot build the conditional "if" that compares if the similar cells of the two rows(of the two sheets), have discrepancies.Can anyone help?
Option Explicit
Sub HighlightMatches()
Application.ScreenUpdating = False
'Declare variables
Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long, bln As Boolean
'Set up the count as the number of filled rows in the first column of Sheet1.
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
'Cycle through all the cells in that column:
For iRow = 1 To iRowL
'For every cell that is not empty, search through the first column in each worksheet in the
'workbook for a value that matches that cell value.
If Not IsEmpty(Cells(iRow, 1)) Then
For iSheet = ActiveSheet.Index + 1 To Worksheets.Count
bln = False
var = Application.Match(Cells(iRow, 1).Value, Worksheets(iSheet).Columns(1), 0)
'If you find a matching value, indicate success by setting bln to true and exit the loop;
'otherwise, continue searching until you reach the end of the workbook.
If Not IsError(var) Then
bln = True
Exit For
End If
Next iSheet
End If
'If you do not find a matching value, do not bold the value in the original list;
'if you do find a value, bold it.
If bln = False Then
Else
Cells(iRow, 1).Interior.ColorIndex = 9
'here should be the conditional if
End If
Next iRow
Application.ScreenUpdating = True
End Sub
Related
I have a workbook that is never received in the same format. To prevent manual intervention, I need to capture the Column that the text employee is in. For example, if the text is in column O - I would execute the below, but I would need the Cells(i,"O") to be changed based off the cell that contains the text employee
Sub DoThis()
Application.ScreenUpdating = False
Dim i As Long
For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
If Not IsEmpty(Cells(i, "O").Value) Then
'stuff here
End If
Next i
End Sub
You can use the Find method and get the column of the cell that employee is found in to use in Cells :
Option Explicit
Sub DoThis()
Dim i As Long
Dim lngCol As Long
With Worksheets("Sheet1") '<-- change to your sheet
lngCol = .Rows(1).Find("employee").Column '<-- assumes header in Row 1
For i = .Range("A" & .Rows.Count).End(3).Row To 2 Step -1
If Not IsEmpty(.Cells(i, lngCol).Value) Then
'stuff here
End If
Next i
End With
End Sub
Use the find method
Cells.Find("employee")
This will find the cell in the range specified (here I've used Cells but I'd narrow this down to your range) and it will return the cell that contains the text "employee". You can then reference this as a Range object i.e. use .Row to get the row number or .Column to get the column number
What i am trying to do is look into another excel sheet and pick out information from the rows that have the same string as another in a different sheet. I need to loop though the list and pick out only a few values from the rows. I am still a long shot from achieving this so first im just looking into the sheet1 trying to compare it to the other cell in sheet2.If they have the same value i want to pick out certain cell value in the row where they find the same value and then put them into the other sheet. Apologies if this does not make sense. Here is my code so far. Also i get an error 'object defined when i run the code. When i debug its the line with the if statement thats going wrong
Sub Awesome_macro()
Dim x As Integer
Dim Counter As Integer
' Set numrows = number of rows of data.
NumRows = Range("H15", Range("H15").End(xlDown)).Rows.Count
' Select cell a1.
Range("H16").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
If StrComp(Sheets("Sheet1").Cells(H, 15).Value, Sheets("Sheet2").Cells(A, 1).Value) = 0 Then
Sheets("Sheet1").Range("D15").Copy Destination:=Sheets("Sheet2").Range("B2")
End If
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
End Sub
Try following piece of code:
Value2Find = Sheets("Sheet2").Cells(A, 1).Value
Row_Num = Sheets("Sheet1").Range("A:A").Find(What:=Value2Find, LookIn:=xlValues).Row
I kind of found a way to to it but its not looping through correctly
Sub Awesome_macro()
Dim x As Integer
Dim Counter As Integer
' Set numrows = number of rows of data.
NumRows = Range("H15", Range("H15").End(xlDown)).Rows.Count
' Select cell a1.
Range("H16").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
If (Sheets("Sheet1").Range("H15").Value = Sheets("Sheet2").Range("A1").Value) Then
Sheets("Sheet1").Range("D15").Copy Destination:=Sheets("Sheet2").Range("B3")
End If
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
End Sub
Its printing something into the sheet2 now so the comparing the values and printing on the page works. just need to figure out how to loop it properly
What I am trying to do is :
loop through Column Q on Sheet "Global" starting at row 3
For every cell match value to UserForm ComboBox2 Column2, and the copy the entire row to the relevant sheet from userform2 coloum1.
loop though until last row. There could be several unique values in Column Q but will all be in the Userform2's Combobox2 columns.
I have no code as an example as I have no idea where to even begin!
This is my comboxbox, as is displays, on the backing of it each item have the below code, so a name, a code "2780" and a reference "BRREPAIRS".
.AddItem "Repairs"
ComboBox2.List(13, 1) = "2780"
ComboBox2.List(13, 2) = "BRRPEAIRS"
I need it to loop through everycell on the global sheet in column G, then match the cell value to the combobox list item from column 2. Once it has found a match it uses the code from column 1 ie "2780" to copy the entire row to the sheet matching the code in column 1.
Hopefully i have explained it a little better.
Private Sub CommandButton1_Click()
Dim findmatch As Object
Dim lastcell As Integer
Set findmatch = ThisWorkbook.Sheets("Global").Range("G:G").Find(What:=UserForm2.ComboBox2.column(1), LookIn:=xlValues)
If Not findmatch Is Nothing Then
lastcell = ThisWorkbook.Sheets(UserForm2.ComboBox2.Value).Cells(100000, 7).End(xlUp).row 'here find a way to locate last cell in sheet that has your name.. it keeps returning me 1 but other than that it works fine
ThisWorkbook.Sheets(UserForm2.ComboBox2.Value).Range(Cells(lastcell, 1), Cells(lastcell, 40)) = Range(Cells(findmatch.row, 1), Cells(findmatch.row, 40)).Value
Else
MsgBox "not found"
End If
End Sub
I have managed to get it to work with the following code below. It looks for the correct cell in the combobox. Then copies it to the correct sheet in the correct position.
The only problem is that it runs very slowley!! Can anyone suggest some way of speeding it up?
And the last question is, having error handling for if a sheet doesn't exists, it tell you to create the sheet, or even create the sheet for you??
I really appreciate all the help guys, have been bashing my head on the wall for days!!!
Dim i, lastD, lastG As Long
Dim j As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
' find last row
lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row
For i = 3 To lastG
lookupVal = sheets("Global").Cells(i, "Q") ' value to find
' loop over values in "details"
For j = 0 To Me.ComboBox2.ListCount - 1
currVal = Me.ComboBox2.List(j, 2)
If lookupVal = currVal Then
sheets("Global").Cells(i, "Q").EntireRow.Copy
sheets(Me.ComboBox2.List(j, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
End If
Next j
Next i
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
I have been using simple excel array formulas to count certain values on a master sheet but now at the point where I have too many formulas in my document and excel is crashing.
Therefore, I would like to create a macro that can do the same task. I would like to have the code do the following:
IF the activecell in Sheet1 matches to any cell in a column(or range) in Sheet2,
AND IF the cell in the same row in an adjacent column in Sheet2 is not blank,
THEN count all the instances that specific string appears in Sheet2 column A
AND place the value 2 columns to the right of the original active cell in Sheet1.
Here is the original array formula I was using:
=SUM(IF(Sheet1!$A8=Sheet2!$A:$A,IF(SalesF_SignUp_data!$C:$C>1,1,0)))
The formula above is taking the cell A8 in Sheet1 and checking if it matches to any cell in Sheet2 column A,
AND making sure that column C in Sheet2 is not blank in the same row.
If this is TRUE then "add 1" for all the instances
AND place that value in Sheet1.
I believe the best way to do this is a For Next Loop but haven't been able to execute any successful code based on examples I've found.
Im happy to explain further if needed. Since I dont have a reputation of 10 I cant attach images but am willing to send if needed.
This is set up to run for all the cells you've selected in column A of sheet 1.
It looks in Sheet2 column A for the value on Sheet1 column A, then in Sheet1 column B, displays how many times the value appeared in Sheet2 column A along with a value in the same row of column C.
If the answer is helpful, please mark it as such. :-)
Option Explicit
Sub countinstances()
Dim result, counter, loopcount, tocomplete, completed As Integer
Dim findtext As Variant
Dim cell, foundcell, nextcell As Range
'Checks to make sure the sub isn't accidentally run on an invalid range
If ActiveSheet.Name <> "Sheet1" Or ActiveCell.Column <> 1 Or Selection.Columns.Count > 1 Then
MsgBox ("Please select a range in column A of Sheet 1.")
Exit Sub
End If
'In case of selecting the entire column A, curtail the number of blank cells it runs on.
tocomplete = Application.WorksheetFunction.CountA(Selection)
completed = 0
'For each cell in the selected range, searches Sheet2, Column A for the value in the selected cell
For Each cell In Selection
If completed = tocomplete Then Exit Sub
If cell.Value <> "" Then completed = completed + 1
findtext = cell.Value
result = 0
Set foundcell = Sheets("Sheet2").Range("A1")
'Uses the count function to determine how many instances of the target value to search for and check
loopcount = Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), findtext)
'Skips the loop if the target value doesn't exist in column A
If loopcount = 0 Then GoTo NotFound
'For each time the target value was found, check the cell in column C. If it's not blank, increment "result"
For counter = 1 To loopcount
Set nextcell = Sheets("Sheet2").Range("A:A").Find(what:=findtext, lookat:=xlWhole, after:=foundcell)
If nextcell.Offset(0, 2).Value <> "" Then
result = result + 1
End If
Set foundcell = nextcell
Next
'Put the result in column B of Sheet1
NotFound:
cell.Offset(0, 1).Value = result
Blanks:
Next
End Sub
With some help, I've put together two functions that will work in unison to first convert all of my data from the "text" format to a "number" format. After which it will set each column to a fixed number of characters.
The two sub-routines I'm using are listed below, but I can't figure out how to omit certain rows/columns for the respective functions.
When running the psAdd function, I want to omit the first 3 rows from the range, and for the FormatFixedNumber function I want to omit several columns. The problem with the latter is that I have 1000+ columns of data and a key header row containing a 1 or 0 that represents whether the column should be converted.
How could modify this code to skip the first 3 rows in the first sub, and several columns marked with a 0 in the second?
Sub psAdd()
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Cells
Set x = Range("A65536").End(xlUp).Offset(1)
If x <> "" Then
Exit Sub
Else
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal
End Sub
Sub FormatFixedNumber()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To lastCol 'replace 10 by the index of the last column of your spreadsheet
With Columns(i)
.NumberFormat = String(.Cells(2, 1), "0") 'number length is in second row
End With
Next i
Application.ScreenUpdating = True
End Sub
1. First code
At the moment you are working on all the cells on a sheet with z. You can reduce this to the UsedRange - ignoring the first three rows by
forcing the UsedRange to update before using it (to avoid redunant cells)
testing if the z exceeds 3 rows
if so resize z by three rows using Offset and Resize
Sub psAdd()
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
ActiveSheet.UsedRange
Set z = ActiveSheet.UsedRange
If z.Rows.Count > 3 Then
Set z = z.Cells(1).Offset(3, 0).Resize(z.Rows.Count - 3, z.Columns.Count)
End If
'using Rows is better than hard-coding 65536 (bottom of xl03 - but not xl07-10)
Set x = Cells(Rows.Count,"A").End(xlUp).Offset(1)
If x <> "" Then
Exit Sub
Else
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal
End Sub
2. Second code
Run a simple test on each header cell to proceed if it doesn't equal 0. Assuming that the header cell is in row 1 then
Sub FormatFixedNumber()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To lastCol 'replace 10 by the index of the last column of your spreadsheet
If Cells(1, i) <> 0 Then
With Columns(i)
.NumberFormat = String(.Cells(2, 1), "0") 'number length is in second row
End With
End If
Next i
Application.ScreenUpdating = True
End Sub