Vba to reference a cell but remain static in the new cell - excel

My workbook has data that is automatically loaded in from yahoo finance. The data is constantly being refreshed. I need a formula that can take the referenced cell and produce the number value of that cell without updating whenever the referenced cell does. For example: Cell G3 will say 40.75 for the stock value and I need D2 to say 40.75 except that it will remain 40.75 when G3 updates to the new price.
I have tried using =Numbervalue($G$3) but that still updates when the data refreshes.
UPDATE
This is the VBA Code that I have to paste the Date and Time in the active cell (Which is correct) then it will paste the price (G3) in the cell of D2.
Sub TimeStamp()
'
' TimeStamp Macro
'
' Keyboard Shortcut: Ctrl+Shift+T
'
ActiveCell.Formula = "=CONCATENATE(L1,N1)"
ActiveCell.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("D2").Value = Range("G3").Value
End Sub
My problem is that I need the Range("D2").Value = Range("G3").Value part of the code to recognize the next empty cell in Column D. Currently, it will replace whatever data is already in the D2 cell.

You can write on your macro to the first empty row on column D by replacing this line:
Range("D2").Value = Range("G3").Value
With this one:
ActiveSheet.Columns(4).End(xlDown).Offset(1, 0).Value2 = Range("G3").Value2
Regards,

Related

Excel VBA adding titles to Subtotalled Information under second view in First Visible Cell

In my excel file, I use a subtotal to sort large quantity of information, Normally, when doing this manually, I select the second view then in the first row, use = and the column above. For example, if the first Visible Cell is 15, then in A15, I add in = A14, in B15 I add in B14, in C15 I add in C14, in D15 I add in D14. Then I copy the first row (A-D) and select the whole subtotalled units in the sheet, select visible cells only and copy and paste special formulas to see the subtotalled information.
Normally this is done entirely manually but I have been trying to find a macro that will add the subtotal titles.
1
2
3
4
5
7
8
The one I tried is meant to find the first blank cell in row A, but it is finding A15 every time instead of the first visible cell. This will not be A15 every time, as it will be different information every week so different subtotals.
Wrong Subtotal
Sub MacroAddingTitles()
'
' MacroAddingTitles Macro
' Adding Titles to Subtotals
'
'
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A15").Select
ActiveSheet.Outline.ShowLevels RowLevels:=3
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("A16").Select
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A15").Select
Selection.Copy
Range("B15:D15").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
Any Suggestions?

Is there a VBA string to select copied cells that used to have a blank formula?

I have an excel file where everything is controlled via a macro. At one point I am moving files from one sheet to another where this data is stored as a backlog.
I then try to select blank cells and remove the row if true. But cells appear blank but are not.
So I am moving it from Sheet A to Sheet B. The data in Sheet A is being moved and pasted as values in Sheet B. The data being moved has two columns: Column A holds Item ID and column B holds a date when the item cease to exist (Cease Date).
In Sheet A, Cease Date is populated through a simple formula (=+IF(O5<>"";O5;N5)) where if there is no new Cease Date input, fetch from backlog.
Now, if there neither is no new Cease Date input nor is there any backlog, the cell is blank.
When the macro copy and paste (as values) the data from Sheet A into Sheet B, column B is populated by blank cells (as intended) but there is something invisible, for lack of better word. Almost like there would be a formatting or like when you can encounter hidden characters not seen other than by ANSI.
IF I select any of the empty cells and press delete, then run "Go to special..." and blanks, the cell gets selected by the function.
I'm using this line to remove blanks:
Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
This is the segment of my code that copy/paste and handle the Cease Date section:
Sheets("Dashboard").Select
Range("B3:Q400").Select
Selection.Copy
Sheets("CeaseDate").Select
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:T").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("F1:G1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("F:G").Select
Selection.Delete Shift:=xlToLeft
Columns("B").SpecialCells(xlBlanks).EntireRow.Delete 'Remove rows that does not contain a Cease Date <--- This does not work since it wont treat the blank cells as blank
'Range converting to date format
Columns("B:B").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("A:B").Select
ActiveSheet.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
Selection.End(xlUp).Select
So I found a solution to this, I cannot explain why the problem occurs but apparently it has been something occurring in Excel since at least version 2003.
Problem: When I copy cells and use paste-special-value, the cells that appeared blank will fail the test of =ISBLANK() and returning a FALSE value. Yet, there is nothing to copy from the cell or anything to mark. If I select the apparently blank cell and press delete or Backspace, =ISBLANK() will now return a TRUE value.
Solution:
I select the area with the apparently blank cells
Open Find/Replace function and leave the Find What: blank (no spaces or anything)
and then in the Replace With: type in a string or word that you
KNOW does not appear anywhere else in the spreadsheet.
Click Replace All
All apparently blank cells will be replaced with the word
Now take the word and Find/Replace it with nothing
The replaced cells will now be truly blank and pass the =ISBLANK() test
I originally found this (quite obscure) solution here
If you have a cell that contains a formula, but the Value of that Formula is equivalent to ="", then it will display as Blank, and the COUNTBLANK function in Excel (or WorksheetFunction.CountBlank function in VBA) will call it Blank, but SpecialCells(xlBlanks) will not - because the Range.Formula property is not blank.
Here is a Function to retrieve cells with a Blank Value in a range:
Private Function GetNullValues(ByVal Target As Range) As Range
Dim TestingArea As Range, TestingCell As Range
For Each TestingArea In Target.Areas 'Loop through Areas in Target
For Each TestingCell In TestingArea.Cells 'Loop through Cells in Area
If TestingCell.Value = "" Then 'If Cell looks Blank
If GetNullValues Is Nothing Then 'If first blank found
Set GetNullValues = TestingCell 'Start list
Else 'If not first blank
Set GetNullValues = Union(GetNullValues, TestingCell) 'Add to list
End If
End If
Next TestingCell, TestingArea 'This is the same as doing 2 Next lines
End Function
Use it like this: Set BlankCells = GetNullValues(Sheet1.Columns(2))
What you could try is also removing formatting. I have encountered this several times and it worked for me with this code. with this line all formats in blank cells are removed.
Columns("B").SpecialCells(xlBlanks).EntireRow.ClearFormats
what you could also try is adding the .clearformats function to every delete part.
so if you have
sheet1.column("B").clearcontent
you could add
sheet1.column("B").clearcontent
sheet1.column("B").clearformats

How to check a range for a cell value and then insert another value in VBA

I am new to VBA and macros and want to learn it by automating parts of my "timesheet tracking" Excel.
The idea is that I always enter the new calendar week in a cell as a reminder (so this is done manually).
What the macro shall do:
1) copy the cell which sums up all my worked hours (so one specific cell). This value is in worksheet "Week Timesheet"
2) Go and take this value, look in another worksheet ("Year Overview") if this value (the calendar week number) is in a range (the range is a list of each calendar week, so 1 up to 52, it is column A) and if so paste the copied value in the column C.
Can you help me with that? Below the code I started to do.
Thanks for your help!
Sub
If Worksheets("Week Timesheet").Range("K6").Value = Worksheets("Year Overview").Range("A2:53").Value Then
Worksheets("Week Timesheet").Range("I37").Select
Selection.Copy
Sheets("Year Overview").Select
Range("C11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
I'm not sure if I understood right. You want to copy the week value everytime in Cell("C11")? So the value gets overwritten everytime. You better want the value to be summed up, right? I made two versions, hope it helps you:
Version (1): overwrite cell ("C11")
Version (2): summ up cell ("C11")
Sub insertworkinghours()
Dim i As Integer
For i = 1 To 52
If Worksheets("Week Timesheet").Range("K6").Value = Worksheets("YearOverview").Cells(1, 1 + i).Value Then
Worksheets("Year Overview").Range("C11").Value = Worksheets("Week Timesheet").Range("I37").Value '(Version 1)
Worksheets("Year Overview").Range("C11").Value = Worksheets("Year Overview").Range("C11").Value + Worksheets("Week Timesheet").Range("I37").Value '(Version 2)
End If
Next
End Sub

Copying values, applying a formula and pasting the results as values. All operations in different Sheets - VBA Macro Excel

I am trying to create a Macro in Excel with VBA, that builds a bunch of different email addresses with a person's first, middle and last name and the company's email domain. I then want to verify these different email addresses with an email bulk tester which is another application.
In Sheet1 I have the input data for the email addresses in the following columns:
First names: F
Middle names: G
Last names: H
Email domains: I
Since there are 52 different persons whose email addresses I want to find, all the data is thus in cells F2:I53.
On Sheet2 I would need to fill in the first, middle and last name as well as the email domain of each person separately in cells B2:B5. On the same Sheet, 46 different possible email addresses will be generated for each person in cells G2:G47.
On Sheet3, I want to copy paste all 46 different email addresses as values. For the first person, I want to copy paste these 46 email addresses into cell A3. For the second person I want to copy paste them into cell A49, for the third person into cell A95, etc. Since I wanna do this for 52 persons, the last populated cell should be A2394.
Here you can take a look at this table which I would normally have in excel:
https://docs.google.com/spreadsheets/d/1kWPfscdnz_TCS7K1H3to1rBgRzJ9XSBH8L7rjKhlTnc/edit?usp=sharing
Thus the macro is supposed to do the following in the first iteration:
Select and copy cells F2:I2 on Sheet1
Go to Sheet2 and special paste them (transpose) in cells B2:B5
Select and copy cells G2:G47
Go to Sheet3 and past them as values into cell A3
In the second iteration, the macro is supposed to do the following:
Select and copy cells F3:I3 on Sheet1
Go to Sheet2 and special paste them (transpose) in cells B2:B5
Select and copy cells G2:G47
Go to Sheet3 and past them as values into cell A49
As you can see in 1) and 2), the row number increments after every iteration. This whole process is thus to be repeated 52 times. Below, you can see the macro I have created
Sub Macro1()
Dim i As Integer
Dim m As Integer
For i = 1 To 52
'selecting the first, middle and last name (columns I to F)
m = i + 1
Range("F" & m & ":I" & m).Select ' maybe I need to use the Indirect function here?
Selection.Copy
Sheets("Sheet2").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
' Maybe give excel some time to calculate the email addresses first?
Application.Calculate
Range("G2:G47").Select
Selection.Copy
Sheets("Sheet3").Select
'Find the first empty cell in column A
Range("A1").End(xlDown).Offset(1, 0).Select
'pasting the email addresses as values
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'end of iteration
Next i
End Sub
However, when I run the macro, the cells A3:A2394 on Sheet3 only contain the # sign (see google sheet). Unfortunately, I have no idea where exactly the error occurs. My suspicion was that I need to give excel some time to calculate the 46 different email addresses in G2:G47 in Sheet2, so I added the "Application.Calcuate" command, but it also didn't work.
Would be awesome if someone of you could help.
Thanks in advance,
Kevin
I cannot comment so i have to put it as answer.
The problem i guess, is that your code is not specific to where range is selected. To improve your code, you might want to try:
dim wSheet1 as Workbook
dim wSheet2 as Workbook
dim wSheet3 as workbook
set wSheet1 = Workbooks("Sheet1")
set wSheet2 = Workbooks("Sheet2")
set wSheet3 = Workbooks("Sheet3")
then use:
wSheet1.Range(....)
to specify which sheet you are referring to rather than .select.
Below code is now working:
Sub Macro1()
Dim i As Integer
Dim m As Integer
Dim wSheet1 As Worksheet
Dim wSheet2 As Worksheet
Dim wSheet3 As Worksheet
Set wSheet1 = Sheets("Sheet1")
Set wSheet2 = Sheets("Sheet2")
Set wSheet3 = Sheets("Sheet3")
For i = 1 To 52
'selecting the first, middle and last name (columns I to F)
m = i + 1
wSheet1.Range("F" & m & ":I" & m).Copy
wSheet2.Range("B2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
' Maybe give excel some time to calculate the email addresses first?
Application.Calculate
wSheet2.Range("G2:G47").Copy
'Find the first empty cell in column A and paste as values
wSheet3.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'end of iteration
Next i
' code from the macro runner
'Range("F2:I2").Select ' question is how to select the same range next time, only one row lower?
'Selection.Copy
'Sheets("Sheet2").Select
' pasting the name (as transpose)
'Range("B2").Select
'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
' selecting all the possible email addresses
'Range("G2").Select ' shouldn't it be Range("G2:G47).Select ?
'Range(Selection, Selection.End(xlDown)).Select
'Application.CutCopyMode = False
'Selection.Copy
' paste all possible email addresses as values into Sheet3
'Sheets("Sheet3").Select
'Range("A1").Select ' Question is how to select the first empty row in column A of that Sheet
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

loop and select next cell excel macro

Hello hope all is well :)
having trouble figuring out how to loop and select next cell
so when a cell in the range h3:z3 is empty it would stop :)
and what it is doing is selecting the value from h3 pasteing in b3 runs a another macro which gives an order number in e3 which is then copied and pasted in h4 then it would go to the next cell in I3 paste in b3 copy result from e3 and paste in I4 and do the same
thanks
For Each cell In Range("H3:Z3")
If IsEmpty(cell.Value) Then Exit For
'select ammount and place in lookup
Range("H3").Select
Selection.Copy
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' fill in order numbers
bulkON_Click
'select order and past under postcode
Range("E3").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Selection.Copy
Range("H4").Select
ActiveSheet.Paste
Loop
There's a lot that I would probably change in this code. This should get you started.
For starters, a For loop requires a Next statement, not a Loop (which is used for Do blocks. Also, you should avoid copying/pasting at all costs, in favor of writing values directly to the destination cell(s).
I assume that cells "B3" and "E3" are constant, and you are iterating over cells in H3:Z3 and computing some value to put in corresponding cell in H4:Z4.
For Each Cell In Range("H3:Z3")
If Cell.Value = vbNullString Then Exit For
'select ammount and place in lookup
Range("B3").Value = Cell.Value '<< no need to "copy & paste", just write the value directly
' fill in order numbers
bulkON_Click
'insert the value under postcode
' this OFFSET refers to the cell 1 row below the "Cell"
Cell.Offset(1, 0).Value = Range("E3").Value
Next

Resources