Sub Heading_Data()
num = 1
Sheets("Sheet1","Sheet2","Sheet3").Select
Range("A" & num).Select
ActiveCell.FormulaR1C1 = "Branch"
Range("B" & num).Select
ActiveCell.FormulaR1C1 = "Project"
Range("C" & num).Select
ActiveCell.FormulaR1C1 = "Customer"
End Sub
The above code works fine where in the value of A1, B1 and C1 in each of the three sheets get the values Branch, Project and Customer respectively.
I want to avoid using the Select before setting the values accordingly I modified the code to the following
Sub Heading_Data()
num = 1
Sheets("Sheet1","Sheet2","Sheet3").Select
Selection.Range("A" & num).Value = "Branch"
Selection.Range("B" & num).FormulaR1C1 = "Project"
Selection.Range("C" & num).FormulaR1C1 = "Customer"
End Sub
The above only set the value on Sheet1 but rest of the two sheets are set with blanks.
Kindly advise the correct way to set the value without using Select.
Looping through those sheets and setting the values for each one is the only solution I can think of.
Sub Heading_Data()
num = 1
sheetsArray = Array("Sheet1","Sheet2","Sheet3")
For Each sheetName in sheetsArray
Sheets(sheetName).Range("A" & num).Value = "Branch"
Sheets(sheetName).Range("B" & num).FormulaR1C1 = "Project"
Sheets(sheetName).Range("C" & num).FormulaR1C1 = "Customer"
Next sheetName
End sub
Related
I am posting here again and need very much working and specific codes for making a VBA macro for copying some specific cells from one worksheet to another using one button.
Here you can see my current invoice format -
And here is the Database sheet -
Problem here is - Using the New Invoice button, I want to move to a new invoice while the data from specific cells, Invoice#, Order#, Sale#, Date#, Client's Name, Subtotal, Order Type, will be copied or moved from Invoice sheet to Database sheet. Also, the contents of these cells will be cleared as well.
I have the code for clearing contents and adding new invoice number -
Sub NewInvoice()
Range("H8").Value = Range("H8").Value + 0.00001
Range("D8:D10").ClearContents
Range("C13:C23").ClearContents
Range("H9:H10").ClearContents
Range("H25:H27").ClearContents
UserForm1.Show
End Sub
I need to add the codes for copying data from one worksheet to another worksheet inside this same code, for the specific cell data.
I hope I could explain my situation here.
Waiting for your reply and thank you for your time and consideration.
With regards
Imran
This should do it...
Sub moveData()
Dim db_next_row As Long
Dim invoice_n, order_n, sales_n, date_n As String
Dim c_name, subtotal, order_type As String
'CONFIG HERE
'set the location of the cells in the invoice sheet
'------------------------------------------
invoice_n = ""
order_n = "" 'example: order_n = "B3"
sales_n = ""
date_n = ""
c_name = ""
order_type = ""
subtotal = ""
'-----------------------------------------
db_next_row = Sheets("Database").Cells(Rows.Count, 2).End(xlUp).Row + 1
'move info to database
With Sheets("Database")
.Range("B" & db_next_row) = Sheets("Invoice").Range(date_n)
.Range("C" & db_next_row) = Sheets("Invoice").Range(c_name)
.Range("D" & db_next_row) = Sheets("Invoice").Range(invoice_n)
.Range("E" & db_next_row) = Sheets("Invoice").Range(order_n)
.Range("F" & db_next_row) = Sheets("Invoice").Range(sales_n)
.Range("G" & db_next_row) = Sheets("Invoice").Range(subtotal)
.Range("H" & db_next_row) = Sheets("Invoice").Range(order_type)
End With
'clear content in the invoice
With Sheets("Invoice")
.Range(date_n).ClearContents
.Range(c_name).ClearContents
.Range(invoice_n).ClearContents
.Range(order_n).ClearContents
.Range(sales_n).ClearContents
.Range(subtotal).ClearContents
.Range(order_type).ClearContents
End With
End Sub
I have written a code in VBA where a V-Lookup is done if a certain condition is met.
It works fine but now how can I do the same thing to the next row data values without the need to rewrite the code.
Sub starting_stock()
If Worksheets("out").Range("E2").Value = "" Then
Set ItemRef = Worksheets("out").Range("A2")
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D2").Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
End Sub
I want to do the same to D3 with values of E3, A3 without the need to rewrite the code every time.
This is an Stock Control System.
There are two sheets, One is called "Inventory" and the other is called "out".
Field in Inventory : ProductRef,Initial Stock, Stock Out(SUMIF for all Qty Out corresponding to a particular ProductRef), Final Stock.
Field in out : Product Ref, Starting Stock, Qty out, Remaining Stock, Date.
The aim here is to V-lookup the Final Stock from Inventory into Starting Stock if Qty Out is Null and as per the V-Lookup criteria of product Ref.
Remaining Out has a simple formula Starting Stock- Qty Out.
A normal formula cannot be used since any changes made in Qty will affect all previous entries with the same Product Ref.
Starting Stock should be as at date and remain as such.
All you need to do is wrap it in a For loop. See below:
Option Explicit
Sub starting_stock()
Dim i As Long
For i = 2 To 3
If Worksheets("out").Range("E" & i).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & i)
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D" & i).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
Next i
End Sub
Read more about For loops here: https://excelmacromastery.com/vba-for-loop/
I assume this is what you are looking for:
You want to select a cell in a column and run the code and it will use value of the A column on the same row to perform the vlookup and paste the value in D column with the same row?
In that case ActiveCell.row is probably what you need.
Sub starting_stock()
If Worksheets("out").Range("E" & ActiveCell.Row).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & ActiveCell.Row)
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D" & ActiveCell.Row).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
End Sub
I have found the following solution:
Sub Button_Click()
Dim i As Integer
i = 2
Do While Worksheets("out").Cells(i, 1).Value <> ""
If Worksheets("out").Range("E" & i).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & i)
Set MyRange = Worksheets("Current Inventory").Range("F:M")
Worksheets("out").Range("D" & i).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 8, False)
End If
i = i + 1
Loop
End Sub
A while loop with the condition of not empty ProductRef.
I was tasked with creating a code that will check to see if internal hyperlinks in an excel spreadsheet worked. This code first changes the formulas that were on the spreadsheet and makes them actual hyperlinks (they were originally formulas linking the locations together). The problem that I have now is that I want to create hyperlinks ONLY if Column S has text. If it doesn't, I don't want the "E-COPY" text to be displayed. All of the text in Column S varies (not one line has the same characters), which is why I'm drawing a blank is to how I tell the program to only continue if it has any text, not anything specific. I am working with Excel 2016.
Also, I am doing this to 71935 and counting rows; is there a limit to how many it can go through? If so, what can I do about it?
Thank you!
Sub CreateHyperlinks()
Dim FN As Variant
Dim Path As Variant
Dim count As Variant
Sheets(1).Activate
count = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
For i = 2 To count
If Range("AM" & i).Value = "Yes" And Columns("S") = Then
Range("E" & i).Value = ""
Path = Sheets(1).Range("R" & i).Value
FN = Sheets(1).Range("S" & i).Value
Sheets(1).Range("E" & i).Select
Selection.ClearFormats
Selection.Hyperlinks.Add Anchor:=Selection, Address:=Path & FN, TextToDisplay:="E-COPY"
Range("AM" & i).Value = " "
End If
Next i
End Sub
If you just need to check for any content in ColS then:
If Range("AM" & i).Value = "Yes" And Len(Range("S" & i).Value) > 0 Then
Few things:
'make a reference to the sheet you're working with
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Excel.Application.ThisWorkbook
Set ws = wb.Worksheets(1)
'gets the absolute last row with data in it // ignores empty cells
count = ws.UsedRange.Rows.Count
personally, i hate working with named ranges, so i would suggest setting range references like so
what you wrote
Path = Sheets(1).Range("R" & i).Value
what i believe it should look like
Path = ws.Cells(i, 18).Value
if you want to test the type when working with variants, try this:
'tests the type associated with the variant. an 8 = string
If VarType(ws.Cells(i, 19).Value) = 8 Then
'do your thing
'tests if the value is null
ElseIf VarType(ws.Cells(i, 19).Value) = 0 Then
'do your other thing
here's a list of the vartype enumeration to help you out.
hope it helps!
I am currently working on a project that requires me to use values from a multicolumn list. I have single column listboxes within this userform that I want a value selected given the selected multicolumn list. As of now, I can get the single listboxes to get highlighted but for some odd reason, the values aren't being selected. I need to be able to pull these values if the user doesn't select another list value. I am new at posting in this forum but I have an excel file to demonstrate my problem but do not know how to post it on here.
Since I don't know how to upload the file here's what I've coded:
Private Sub ListBox1_AfterUpdate()
Me.ListBox2.Value = ListBox1.Column(1)
Me.ListBox3.Value = ListBox1.Column(2)
Me.ListBox4.Value = ListBox1.Column(3)
Me.ListBox5.Value = ListBox1.Column(4)
MsgBox ListBox2.Value & " = " ListBox3.Value & " = " ListBox4.Value & " = " ListBox5.Value ' Check values
End Sub
Private Sub UserForm_Initialize()
With ListBox1
.ColumnCount = 15
.RowSource = ActiveSheet.Range("A1:E10").Address
End With
With Sheets("Sheet2")
ListBox2.RowSource = "'" & .Name & "'!" & .Range("Variable1").Address
ListBox3.RowSource = "'" & .Name & "'!" & .Range("Variable2").Address
ListBox4.RowSource = "'" & .Name & "'!" & .Range("Variable3").Address
ListBox5.RowSource = "'" & .Name & "'!" & .Range("Variable4").Address
End With
End Sub
And just so you guys know, the values in the specific columns are limited to the variable ranges. If anyone can help out, it could be truly appreciated. Thanks!
List boxes have the Selected property which is a boolean collection of list items numbered from 0 to ListCount-1.To pre-select the 3rd item in ListBox5 you would use code like ListBox5.Selected(3)=True. Use False to unselect it.
You aren't quite going about it in a way that is easy to correct. Therefore I have written a little code for you to play with. Please create a userform with one ListBox and call it ListBox2 Paste the code below into the UserForm's code sheet.
Option Explicit
Private Sub UserForm_Click()
Static i As Integer
With ListBox2
.Selected(i) = True
MsgBox "ListIndex = " & .ListIndex & vbCr & _
"Value = " & .Value & vbCr & _
"Column(3) = " & .Column(3)
End With
i = i + 1
If i > 6 Then i = 0
End Sub
Private Sub UserForm_Initialize()
Dim Rng(2 To 5) As Range
Dim Id As Integer
With ActiveSheet
Set Rng(2) = .Range(.Cells(3, 3), .Cells(8, 7))
Set Rng(3) = .Range(.Cells(9, 3), .Cells(18, 7))
Set Rng(4) = .Range(.Cells(19, 3), .Cells(28, 7))
Set Rng(5) = .Range(.Cells(29, 3), .Cells(38, 7))
End With
For Id = LBound(Rng) To UBound(Rng)
SetListBox Id, Rng
Exit For ' for testing: exit after doing the first ListBox
Next Id
End Sub
Private Sub SetListBox(Id As Integer, Rng() As Range)
Dim Wdth As String
Dim i As Integer
Wdth = "60 pt"
For i = 2 To Rng(Id).Columns.Count
Wdth = Wdth & "; 0pt"
Next i
With Me.Controls("ListBox" & CStr(Id))
.RowSource = Rng(Id).Address(External:=True)
.ColumnCount = Rng(Id).Columns.Count
.ColumnWidths = Wdth
End With
End Sub
Run the code on F5 and click anywhere on the form - repeatedly if you like.
The basic arrangement is that there is a list with 5 columns. The number of columns is equal to the number of columns in the source range. The first column is 60 pts wide, the others hidden. The idea is that the user selects an item from the visible column and the other ListBoxes are set according to the values in the hidden columns. I didn't set that up but ListBox2.Column(3) will return the value from column 3 of the selected item.
I hope you have all the syntax that you need to make your idea work. It isn't arranged quite the way you want, but I believe it is all there. Good luck.
I am fairly new to Excel Macros and I am looking for a way to loop through the row headings and columns headings and combine them into one cell for each row and column heading until I have combined all of them.
An example of the First Column cell would be "Your Organizations Title"
An Example of the First Row Cell Would be "22. Cheif Investment Officer"
An example of the first combined cell that I want on a new sheet would be this: "22. Chief Investment Officer (Your Organization's Title)
I then want the combined cells on the new sheet to offset one column to the right until it has iterated through all of the rows and columns.
I have just joined the forum and it will not let me post images or I would have. Perhaps this gives a better idea, here is my code now:
Sub Fill()
' Select cell A2, *first line of data*.
Set title = Sheets("Compensation, 3").Range("B6:B500")
Set descr = Sheets("Compensation, 3").Range("C5:AAA5")
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(title.Value)
Do Until IsEmpty(descr.Value)
ActiveCell.Offset(0, 1).Formula = _
"=title.value & "" ("" & descr.value & "")"""
Set descr = descr.Offset(0, 1)
Loop
Set title = title.Offset(1, 0)
Loop
End Sub
When I run it goes puts this into the active cell:
=title.value & " (" & descr.value & ")"
It does not recognize the variables and come up with the NAME error. It also goes into an infinite loop with no output besides the one cell.
Edit:
I cannot answer my own question because I am new to the forum, but using a combination of your answers I have solved the problem!
Here is the finished code:
Sub Fill()
' Select cell A2, *first line of data*.
Set title = Sheets("Compensation, 3").Range("B6")
Set descr = Sheets("Compensation, 3").Range("C5")
offsetCtr = 0
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(title.Value)
Do Until IsEmpty(descr.Value)
ActiveCell.Offset(0, offsetCtr).Formula = title.Value & " (" & descr.Value & ")"
offsetCtr = offsetCtr + 1
Set descr = descr.Offset(0, 1)
Loop
Set descr = Sheets("Compensation, 3").Range("C5")
Set title = title.Offset(1, 0)
Loop
End Sub
Thank you so much!
Option Explicit
Sub GenerateAndPasteFormulaForTitleAndDescription( _
ByVal titlesRange As Range, ByVal descriptionRange As Range, _
ByVal startCellOnDestination As Range)
Dim title As Range
Dim descr As Range
Dim offsetCtr As Long
Dim formulaTemplate As String
Dim newFormula As String
formulaTemplate = "=CONCATENATE([1], '(', [2], ')')"
startCellOnDestination.Worksheet.EnableCalculation = False
For Each title In titlesRange.Cells
For Each descr In descriptionRange.Cells
If title.Value <> "" And descr.Value <> "" Then
newFormula = Replace(formulaTemplate, "[1]", _
title.Address(External:=True))
newFormula = Replace(newFormula, "[2]", _
descr.Address(External:=True))
newFormula = Replace(newFormula, "'", Chr(34))
startCellOnDestination.Offset(0, offsetCtr).Formula = newFormula
offsetCtr = offsetCtr + 1
End If
Next
Next
startCellOnDestination.Worksheet.EnableCalculation = True
End Sub
Here is how to call the above procedure
GenerateAndPasteFormulaForTitleAndDescription _
Sheets("Compensation, 3").Range("B6:B500"), _
Sheets("Compensation, 3").Range("C5:AAA5"), _
Sheets("new sheet").Range("B5")
EDIT: The code loops through combination of title and description, checks if both of them aren't empty and creates a formula. It pastes the formula into the start cell (Sheets("new sheet").Range("B5") in this case) and moved ahead and pastes the next formula in the column next to it
Basically, you are trying to use VBA objects in worksheet functions. It doesn't quite work that way.
Try replacing
"=title.value & "" ("" & descr.value & "")"""
with
=title.value & " (" & descr.value & ")"