VBA Excel Comparing Values in two different sheet - excel

I am looking to compare the values in two columns that are located in different sheets. When a match is found I want to decrease the value in a third column that is in the same row as the matched values. I know how to hard code it below but I would rather not have to include this code for every row in excel.
If Range("g12").Value = Worksheets("Inventory Levels").Range("b2").Value Then
Worksheets("Inventory Levels").Range("c2").Value = Worksheets("Inventory Levels").Range("c2").Value - 1
End If

You can do this in a simple loop, see my comments for details.
Dim i as Integer
' Use "With" to fully qualify your sheet objects.
With ThisWorkbook
' Loop over rows 2 to 20 (change this as necessary)
For i = 2 to 20
' Use ampersand (&) for concatenation of strings
If .Sheets("Sheet1").Range("G" & (i + 10)).Value = .Sheets("Inventory Levels").Range("B" & i).Value Then
.Sheets("Inventory Levels").Range("C" & i).Value = .Sheets("Inventory Levelts").Range("C" & i).Value - 1
End If
Next i
End With

Related

Excel VBA - How to select a column by Column Number and insert a new column in one sheet after compared with two different worksheets?

I have a VBA code that will compare two values in two different worksheets. When condition gets true, it supposed to select a column and insert one column to right in one workbook only (in my case, it should be in ws, not in wsProductivity).
Though I used With & End With statement, the selection and insertion were happened in both worksheets that I used for comparison.
The code is below.
'ws & wsProductivity - two sheets that are used for comparison
count = 0
For j = 0 To wsProductivity.Range("D3").Value - wsProductivity.Range("D2").Value
If ws.Cells(4, j).Value <> wsProductivity.Cells(wsProductivity.Range("D1").Value, count + wsProductivity.Range("D2").Value).Value Then
With ws
Columns(j).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'Here is the issue where insertion happened in both ws and wsProductivity sheets
End With
ws.Cells(4, j).Value = wsProductivity.Cells(wsProductivity.Range("D1").Value, count + wsProductivity.Range("D2").Value).Value
count = count + 1
Else
count = count + 1
End If
Next j
It would be very much appreciated, if someone could help on it..

VBA formula removing everything after second space

I was trying to copy from column D to column E first two words of each row but still can not find where the error is....
Range("E1:E" & lLastRow).Formula = "=LEFT(D1,FIND("" "",D1,FIND("" "",D1)+1)-1)"
Another option, instead of using a Formula, you can use the Split function.
Code
Dim i As Long, LastRow As Long
Dim WordsArr As Variant
' loop through rows
For i = 1 To LastRow
WordsArr = Split(Range("D" & i).Value, " ") ' use Split and space to read cell words to array
If UBound(WordsArr) >= 1 Then ' make sure the cell contents is at least 2 words
Range("E" & i).Value = WordsArr(0) & " " & WordsArr(1) ' insert only the first 2 words
Else ' in case there are less than 2 words
' do someting....
End If
Next i
End Sub
Try this instead ...
Range("E1:E" & lLastRow).FormulaR1C1 = "=LEFT(RC[-1],FIND("" "",RC[-1],FIND("" "",RC[-1])+1)-1)"
I find using R1C1 better for those sort of operations, especially given you want your references to be dynamic, not absolute.
Alternatively, add the formula you had normally and simply fill down.

Excel VBA Sum from Multiple Sheets

I am trying to create a function or functions that can sum daily hours from time cards for each client to come up with the total hours worked per day. Each client has it's own sheet inside of a single workbook.
Currently, I have a function that determines the sheet that goes with the first client (the third sheet in the workbook):
Function FirstSheet()
Application.Volatile
FirstSheet = Sheets(3).Name
End Function
And one to find the last sheet:
Function LastSheet()
Application.Volatile
LastSheet = Sheets(Sheets.Count).Name
End Function
The part that I am having trouble with it getting these to work within the sum function.
=sum(FirstSheet():LastSheet()!A1
That is basically what I want to accomplish. I think the problem is that I don't know how to concatenate it without turning it into a string and it doesn't realize that it is sheet and cell references.
Any help would be greatly appreciated.
So, an example formula would look like this:
=SUM(Sheet2!A1:A5,Sheet3!A1:A5,Sheet4!A1:A5)
That would sum Sheet2-Sheet4, A1:A5 on all sheets.
Is there a reason you need to write the VBA code to do this?
Can't you just enter it as a formula once?
Also, if you're going to the trouble of writing VBA to generate a formula, it may make more sense to just do the sum entirely in VBA code.
If not, try this:
Sub GenerateTheFormula()
Dim x, Formula
Formula = "=SUM(" 'Formula begins with =SUM(
For x = 3 To Sheets.Count
Formula = Formula & Sheets(x).Name & "!A1," 'Add SheetName and Cell and Comma
Next x
Formula = Left(Formula, Len(Formula) - 1) & ")" 'Remove trailing comma and add parenthesis
Range("B1").Formula = Formula 'Where do you want to put this formula?
End Sub
Results:
The functions return strings and not actual worksheets. The Worksheet does not parse strings well. So add a third function that uses the Evaluate function:
Function MySum(rng As Range)
MySum = Application.Caller.Parent.Evaluate("SUM(" & FirstSheet & ":" & LastSheet & "!" & rng.Address & ")")
End Function
Then you would simply call it: MySum(A1)
It uses the other two function you already have created to create a string that can be evaluated as a formula.
I didn't understand ur question completely but As I understood u have different sheets of different clients which contains supoose column 1 date and column 2
contains hours on that particular date wise hours and a final sheet which column1 contains name of client and column 2 contains total hoursPlease try it
Sub countHours()
Dim last_Row As Integer
Dim sum As Double
sum = 0
'Because I know number of client
For i = 1 To 2 'i shows client particular sheet
last_Row = Range("A" & Rows.Count).End(xlUp).Row
Sheets(i).Activate
For j = 2 To last_Row
'In my Excel sheet column 1 contains dates and column 2 contains number of hours
sum = sum + Cells(j, 2)
'MsgBox sum
Next j
'Sheet 3 is my final sheet
ThisWorkbook.Sheets(3).Cells(i + 1, 2).Value = sum
sum = 0
Next i
End Sub
Happy Coding :

Excel VBA code inputing the correct numbers

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.

Optimize my search and copy code

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:

Resources