vba excel look up with variable - excel

Every month I update my new aged balance, and then I create automatically a new sheet with a macro, which will filter customer.
So here are my current sheets:
Each month, I'm following my customers's payments by adding comments at Column 10.
On the latest page, I want to add old comments after the column 10 so at column 11,12,13 there will be old comments... So there will be as many new columns as there are sheets of customers.
Old comments are in sheets "clients 2019-01-31" and "clients 2019-02-28"
I want to add them in "clients 2019-03-30"
For doing that, i think using Vlookup was the best plan. But looks like I have too many variable, it doesn't work:
Error 1004.
I really tried much things, like declaring sheets before each cells, activating the sheet just before.
Worksheets(Sheets.Count).Activate
I can't get it working. If something isn't clear, please tell me I'll try to explain it better.
Sub Macro1()
Dim nbCustomer ' Customer Number, this value is not fix in my whole program
nbCustomer = 244
Dim numCol ' Column Number
numCol = 11
Dim nbws ' Sheets number
nbws = Sheets.Count
nbws = nbws - 1 ' Because we don't need to lookup on the last page
While (nbws > 1)
Dim numL ' Line Number
numL = 2
While (numL <= nbCustomer)
nbCustomer = nbCustomer + 10
Worksheets(Sheets.Count).Cells(numL, numCol) = Application.VLookup(Cells(numL, 1), Sheets(nbws).Range(Cells(1, 1), Cells(nbCustomer, 10)), 10, False)
numL = numL + 1
nbCustomer = nbCustomer - 10
Wend
numCol = numCol + 1
nbws = nbws - 1 ' we will look up our data on the previous sheet
Wend
End Sub

Related

Matching the data across column and rows using VBA

I have two sheets :
Sheet 1 consist of :
Sheet 2 consist of :
And the output should show in M column in Sheet1. I am attaching the sample output here :
So,what I have here is ID in Sheet 1, for eg : ID 'US' has Abhay,Carl and Dev
and in Sheet3, I have names in column and ID in Rows.
What i want is my Sample output column should populate using macro based on matched values from Sheet3
I am using below logic but something is going wrong :
For i = 2 To 10
j = i + 1
If ThisWorkbook.Sheets("Input").Range("N" & i) = ThisWorkbook.Sheets("Sheet3").Range("A" & i) And ThisWorkbook.Sheets("Input").Range("K" & i) = ThisWorkbook.Sheets("Sheet3").Range("B1") Then
ThisWorkbook.Sheets("Input").Range("O" & i) = ThisWorkbook.Sheets("Sheet3").Range("B" & j)
End If
Next i
Since you asked for a VBA solution, please see the code below.
Dim colLen As Integer
Dim i As Integer
Dim colPt As Integer
Dim rowPt As Integer
' Counts number of rows on Sheet 1, column B.
colLen = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
' Loops through all names on Sheet 1.
For i = 2 To colLen
' Retain US or NA ID for blank cells.
If Sheets(1).Cells(i, 1) <> "" Then
If Sheets(1).Cells(i, 1) = "US" Then
colPt = 2
Else
colPt = 3
End If
End If
' Find name on Sheet 2 and set row.
rowPt = Sheets(2).Range("A:A").Find(Sheets(1).Cells(i, 2)).Row
' Add ID from Sheet 2 to Sheet 3
Sheets(1).Cells(i, 3) = Sheets(2).Cells(rowPt, colPt)
Next i
Assumptions:
Sheet 1 is the main worksheet, sheet 2 has the lookup data.
All names in the lookup data are unique.
I would recommend including the ID in every row instead of treating it as a heading but that's preference. There are formula solutions that would work for this as well if you want to skip VBA.
There are a few ways to approach this. Below is one of them:
NOTE: for simplicity, I have kept my data on one sheet. You can amend the below formulas as your data is on 2 sheets. Saying that, I have used the same columns as you have in your query
Solution:
Have a "holding column". In my example, I used column J as the holding column (you can hide this column if you want). In J2, type the following formula: =IF(ISBLANK($K2), $J1,$K2). Copy the formula down to all used rows. Then copy the following formula in M2: =VLOOKUP($L2,$A$3:$C$8,IF($J2="US",2,3),FALSE). As per before, copy the formula down to all used rows. This should give you your results

Condesing and deleting information from an Excel macros

I am working with a VB macro. Essentially what I am trying to do is for the macros to read the input and first determine whether or not a cells ID number matches the one in the row. Example: If row 1 has an ID of 1122 and rows 2,3,4 and 5 all match, I want the macro to read that and create a count in the NbrOfA cell. Once it realizes that there is not an ID match it moves on to the next ID and looks for matches of that ID number and continues to create a count. While it is doing this, I also need it to read from another column that has specific strings such as "open", "closed" ect. read that input, and create a separate row titled NbrofOpenA. Once it runs out of data, I then want to have a singular cell that shows the number of actions (NbrOfA) that match the ID number as well as the number of open actions (NbrOfOpenA).
Currently I receive the error: “compile error: sub or function not defined” highlighting the Set Cell(Sheet2.Cells(FirstRowOfI, 23) = NbrOfA
Attached in the excel sheet attached it shows 2 cells deleted. They will not actually be deleted, just wanted to give an idea of what I was looking for
Sub ACount()
Dim FirstRowofI
Dim NbrOfA as Integer
Dim NbrOfOpenA as Integer
Row = 2
Set FirstRowofI = (Sheet2.Cells.Range(Row, 14))
NbrOfA = 0
NbrOfOpenA = 0
If (Sheet2.Cells(Row, 14).Value <> "") Then
NbrOfA = 1
If (Sheet2.Cells(Row, 22) <> "Closed") Then
NbrOfOpenA = 1
Set Row = FirstRowofI
Row = Row + 1
Do While (Sheet2.Cells(Row, 14) = (Sheet2.Cells(FirstRowofI, 14)))
NbrOfOpenA = NbrOfOpenA + 1
If (Sheet2.Cells(Row, 22) <> "Closed" Then
NbrOfOpenA = NbrOfOpenA + 1
Range(Row).EntireRow.Delete
Return
End If
Set Cell(Sheet2.Cells(FirstRowofI, 23)) = NbrOfA
Set Cell(Sheet2.Cells(FirstRowofI, 24)) = NbrOfOpenA
Loop
End Sub
[1
Do you need VBA? You can easily achieve what you're looking for with formulas, heck even a Pivot Table! Here's an example with formulas:

Excel VBA Sum up/Add values together, even those with commas/decimal

I have a problem where I can't add numbers with decimals. Only numbers with no decimals.
I have written a code to sum up values from different cells. This work fine as long as the numbers are without decimals.
Here is my code:
Sub SumValues()
'This makro is made to add values together depending on
'x amount of Sheets in the workbook:
Application.ScreenUpdating = False
'A will sum up the values from each cell,
'depending on the amount of Sheets in the this Workbook:
A = 0
For I = 1 To ThisWorkbook.Sheets.Count
'Adding the values from cell E5 to Cells(5, 5 + (I - 1) * 3),
'with the distance 3 between each cell:
A = A + Cells(5, 5 + (I - 1) * 3)
Next I
'The values A that is added togheter from the cells, is now put in a cell:
Worksheets("Sheet1").Cells(1, 1).Formula = "=" & A & ""
Application.ScreenUpdating = True
End Sub
So for 3 number of sheets, "I" goes from 1 to 3.
So if my cells contain these numbers:
Cell(5,5) = 2
Cell(5,8) = 3
Cell(5,11) = 8
I get the sum in Cell(1,1) = 13
But if I have these values:
Cell(5,5) = 2,2
Cell(5,8) = 3
Cell(5,11) = 8
I get the "run-time error '9': Subscript out of range" Error message when running script.
Any suggestions?
Another question is if it is possible to get the formula into the cell I am adding up the values?
For Examlpe if I have 3 Sheets in my Workbook, it will sum up the values from Cell(5,5) , Cell(5,8) and Cell(5,11).
The sum is shown in Cell(1,1).
But all I get is the number, not the formula.
Is it possible to make the Cell show the formula "=E5+H5+K5"?
This last question might be a "fix" for the first question, if it is the separator "," that is making trouble, maybe?
Thanks
GingerBoy
Tested and working fine
Declare your variables
You need to qualify your objects with a worksheet
No need to toggle off Screen Updating here. You are just modifying one cell
This code will place the Value in A1 and the Formula in B1
Disclaimer:
Your code, and the code below, is subject to a potential Type Mismatch Error if you feed any cell with a non-numerical value into your loop. If there is some chance of any non-numerical cell being in the sum range, you can avoid the error by nesting something like the following inside your loop: If ISNUMERIC(Range) Then.
Sub SumValues()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim A As Double, i As Long, Loc As String
For i = 1 To ThisWorkbook.Sheets.Count
A = A + ws.Cells(5, (5 + (i - 1) * 3))
Loc = ws.Cells(5, (5 + (i - 1) * 3)).Address(False, False) & "+" & Loc
Next i
ws.Range("A1") = A
ws.Range("B1").Formula = "=" & Mid(Loc, 1, Len(Loc) - 1)
End Sub

VBA code required to create a Macro in Excel

I am working on a spreadsheet one element of which requires a repetitive copy/paste from current column into next column, then copy/paste values back into the first column. The columns in the worksheet contain figures for each working day of the year.
The idea being to keep moving the formula along from yesterday's column into today's column. This is part of a process carried out each morning before starting to input today's data into the worksheet.
Ideally the formula would always be in today's column but the data in yesterday's column should be pasted back in as special values.
I need a macro to streamline the process.
Example:
Copy data range BM53:BM146
Paste into BN53:BN146
Copy data range BM53:BM146
Paste Special Values back into BM53:BM146
Next morning when I run the macro it should then
Copy data range BN53:BN146
Paste into BO53:BO146
Copy data range BN53:BN146
Paste Special Values back into BN53:BN146
And so on each day.
I found the code below through online searches. The code is for rows down the spreadsheet. I tried to rework it for my need which is columns across the spreadsheet but got into a mess.
Code:
Sub AddToNextRow()
Dim Count, LastRow As Integer
LastRow = Cells(35536, 3).End(xlUp).Row
For Count = 3 To 22
ActiveSheet.Cells(LastRow + 1, Count).Formula = ActiveSheet.Cells(LastRow, Count).Formula
ActiveSheet.Cells(LastRow, Count) = ActiveSheet.Cells(LastRow, Count)
Next Count
End Sub
The code you have found is rubbish. I suggest you do not visit the site where you got it again.
"35536" should have been "65536" but only if the code was posted before 2007. Until Excel 2007, the maximum number of rows in a worksheet was 65536. Since then you would be told to write Rows.Count which gives the number of rows per worksheet for the version of Excel being used.
The first task is to find the correct column. You could search from the column for 1-Jan-2015; for a macro that is only run once per day this would be acceptable. However, I have used function DatePart to find an approximate start column and have then searched backwards or forwards for the correct column. This is a bit OTT. I would normally recommend the minimum necessary to achieve the desired effect but I wanted to show you some of the possibilities.
The code you found uses ActiveSheet. This can be appropriate but rarely is. Using ActiveSheet relies on the user have the correct worksheet active when the macro is started. The macro will probably fail to find today’s date in the wrong sheet but it is better if your code explicitly references the correct worksheet.
Row 51 may be the row containing dates today but will it always be the correct row? I have made the row a parameter in a function call for the first block of code. Defining it as a constant is another option:
Const RowDate as Long = 51
I normally find using a constant the best approach for this type of problem. I have a list on constants at the top of my modules for rows, columns and anything else that is currently fixed but might change in the future. Should the value ever change, amending the constant definition is all that is necessary to fully update the macro.
I have set four rows in worksheet “Daily” to list of dates but with different start columns so I could test all the exist points from the function:
TestData
The code below output this to the Immediate Window:
Column in row 51 for today is 63=BK
Column in row 41 for today is 64=BL
Column in row 44 for today is 66=BN
Column in row 47 for today is 60=BH
Option Explicit
Sub TestFindColToday()
Dim ColToday As Long
ColToday = FindColToday("Daily", 51)
Debug.Print "Column in row 51 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 41)
Debug.Print "Column in row 41 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 44)
Debug.Print "Column in row 44 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 47)
Debug.Print "Column in row 47 for today is " & ColToday & "=" & ColNumToCode(ColToday)
End Sub
Function FindColToday(ByVal WshtName As String, RowDate As Long) As Long
Dim ColToday As Long
Dim Today As Date
Today = Date
ColToday = DatePart("y", Today) * 5 / 7
With Worksheets(WshtName)
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' This column is after the column for Today
' Move back until correct column found or does not exist
Do While True
ColToday = ColToday - 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value < Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
Else
' This column is before the column for Today
' Move forward until correct column found or does not exist
Do While True
ColToday = ColToday + 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
End If
End With
End Function
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function
I think what you are doing is copying formats, values and formulae forward one column then overwriting the formulae in the yesterday’s columns with their values. If I am wrong, I believe there is enough information for you to adjust the macro to your exactly requirements. Come back with questions as necessary but the more you can do yourself, the faster you will develop.
Sub CopyYesterdayToTodayAndFixYesterday()
' "Yesterday" is the last working day before today. For Tuesday to
' Friday this will be yesterday. For Monday it will Friday. This will
' not be true if columns are omitted for public holidays.
Const RowDate As Long = 51
Const RowCopyFirst As Long = 53
Const RowCopyLast As Long = 146
Const WshtTgtName As String = "Daily"
Dim ColToday As Long
Dim RngSrc As Range
ColToday = FindColToday("Daily", 51)
With Worksheets(WshtTgtName)
Set RngSrc = .Range(.Cells(RowCopyFirst, ColToday - 1), .Cells(RowCopyLast, ColToday - 1))
Debug.Print RngSrc.Address
' Copy yesterday's formats, values and formulae to today
RngSrc.Copy Destination:=.Cells(RowCopyFirst, ColToday)
' Overwrite yesterday's formulae with value
RngSrc.Value = RngSrc.Value
End With
End Sub
It seems you want to copy your formulas from the last used column into a new column then revert the formulas in the original to their values.
with activesheet.cells(53, columns.count).end(xltoleft).resize(94, 1)
.copy destination:=.offset(0, 1)
.value = .value
end with
You should be able to run that daily to generate new columns of formulas to the right. I'm using a set number of rows but those could be adjusted daily as well if it was known what changed them.

How to code in Excel VBA for the following purpose? [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
I have an Excel Workbook with 4 sheets in my hand. Each sheet contains daily data for a stock. Each sheet contains 3 columns: the first column lists "Date": 1/6/04 - 6/20/14. The 2nd column is the daily return of this stock recorded on each day. The 3rd column is the daily volume of this stock.
I want to compile the data in the four sheets to just one sheet with 9 columns: 1st column is the date. 2nd&3rd columns contain the return & volume of the 1st stock; 4th&5th columns have the return & volume of the 2nd stock; 6th&7th for the 3rd stock and 8th & 9th for the last stock. In other words, the data of the four stocks would be listed on the same sheet by "Date".
One problem: the first stock has 2692 trading days recorded, yet the 2nd has only 2638 trading days. The 3rd and 4th stocks both have 2633 days recorded. And, for example, on 5/13/2009, only the 1st and the 4th stocks were traded (with data available), but the 2nd and 3rd stocks do not have data, so 5/13/2009 is not included in the 2nd and 3rd sheet of the raw data file. But I want this date to be included in my final (compiled) data sheet because on this day, at least one stock is available.
Eventually, I wish my final sheet to have all the dates when any stocks were traded. For all the missing data (or missing spots), I wish the cells to be filled with NaN.
How can I achieve this in excel VBA/Macro? I also use R so any coding advice with R on this problem would also help.
Thanks.
This is just an outline (I hope the SO police don't shoot me).
Can you get started with this?
Sub Main()
do ' this is the outer loop
for sheet = 1 to 4
get the lowest unselected date
next sheet
if all sheets are done, then exit sub
for sheet = 1 to 4
get either data or NaN for the selected date
next sheet
loop
End Sub
EDIT: ' (I don't know what "on hold" does) This should be a good model for using arrays. (I'll do anything for 15 points.) I've made many assumptions. You don't need to change dates into integers to compare.
Option Explicit
Sub Demo()
Dim iSheet&, aSheets(2) As Worksheet, Outsheet As Worksheet
Dim iRow&(2), iLastRow&(2), outRow&, iCol1&, iCol2&, Date1$, selectedDate$
Set aSheets(1) = ThisWorkbook.Sheets("adam")
Set aSheets(2) = ThisWorkbook.Sheets("bill")
Set Outsheet = ThisWorkbook.Sheets("zack")
iLastRow(1) = 3: iLastRow(2) = 4 ' ending rows
iRow(1) = 1: iRow(2) = 1 ' starting rows
outRow = 1
Do ' this is the outer loop
selectedDate = "12/31/9999" ' starting date (high)
For iSheet = 1 To 2
If iRow(iSheet) <= iLastRow(iSheet) Then
Date1 = aSheets(iSheet).Cells(iRow(iSheet), 1)
If Date1 < selectedDate Then selectedDate = Date1
End If
Next iSheet
If selectedDate = "12/31/9999" Then Exit Sub ' no more
Outsheet.cells(outRow, 1) = selectedDate
For iSheet = 1 To 2
iCol1 = iSheet * 2 ' output columns
iCol2 = iCol1 + 1
If iRow(iSheet) <= iLastRow(iSheet) Then
Date1 = aSheets(iSheet).Cells(iRow(iSheet), 1)
If Date1 = selectedDate Then
Outsheet.Cells(outRow, iCol1) = aSheets(iSheet).Cells(iRow(iSheet), 2)
Outsheet.Cells(outRow, iCol2) = aSheets(iSheet).Cells(iRow(iSheet), 3)
iRow(iSheet) = iRow(iSheet) + 1 ' next row
Else
Outsheet.Cells(outRow, iCol1) = "na"
Outsheet.Cells(outRow, iCol2) = "na"
End If
End If
Next iSheet
outRow = outRow + 1
Loop
End Sub

Resources