I have two sheets in a workbook. 1st sheet name is “summary” and another is “target”.
I have chart in summary tab. I want to set the source data for that chart to target tab that contains date. Ex(11/01/2013 – 11/30/2013).
Everyday I want to change the chart date for corresponding date. So I tried in excel vba as below:
sheets("Summary ").Select
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.PlotArea.Select
Sheets("Target").Select
a = InputBox("enter the date - format(mm/dd/yyyy)")
Set findrow = Range("a:a").Find(what:=a, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Rows
findrownumber = findrow.Row
ActiveChart.SeriesCollection(2).Values = "='Target Chart'!R4C78:R" & findrownumber & "C78"
End sub
While I am trying to enter source data value in formula it shows error.
Please help me.
This is the code that I tried and it works. I might have switched the names of the sheet while creating this example but you can change that in the code :)
Let's say the Summary Tab looks like this
And your Chart in Target Sheet looks like this at the moment. The source data is set to =Summary!$A$1:$A$6
Now Try this code
Option Explicit
Sub Sample()
Dim wsSum As Worksheet, wsTgt As Worksheet
Dim objChart As ChartObject, chrt As Chart
Dim sDate
Dim findrow As Long
Dim aCell As Range
'~~> Accept the date
sDate = InputBox("enter the date - format(mm/dd/yyyy)")
'~~> Check if user entered something
If sDate <> "" Then
'~~> Set your respective worksheets
Set wsSum = ThisWorkbook.Sheets("Summary")
Set wsTgt = ThisWorkbook.Sheets("Target")
'~~> Find the date in the cell
With wsSum
For Each aCell In .Columns(1).Cells
If Format(aCell.Value, "mm/dd/yyyy") = sDate Then
'~~> Get the row number
findrow = aCell.Row
Exit For
End If
Next aCell
End With
'~~> Update the chart
With wsTgt
Set objChart = .ChartObjects("Chart 1")
Set chrt = objChart.Chart
chrt.SeriesCollection(1).Values = "='Summary'!R4C1:R" & findrow & "C1"
End With
End If
End Sub
When you run the code, in the Inputbox, set the date as "01/11/2013"
And this is the output which you will get with source data set as =Summary!$A$4:$A$11
IMPORTANT: I wouldn't recommend using Inputbox for capturing a date. You might want to use THIS
Related
I am new to VBA and have cobbled this together from code I found in forums and the code generated by a recorded macro. I think it is close, but there is one issue I cannot figure out after much searching. Your help is appreciated.
I have a Worksheet in wb1 with a Value in cell B3, and I want to search for that value in wb2 (across multiple sheets). When the value is located, I want to select a range of cells in the worksheet where the value was found and then copy that back to wb1.
The code successfully finds the value in wb2. It selects a range of cells and copies it back to wb1. The problem is that it does not select the cells from the desired worksheet (where the value was actually found). It selects the range of cells from whichever sheet wb2 was opened to. For example, if Excel opened wb2 to Sheet1, and my Value is found in Sheet3, it still copies the range from Sheet1.
I need it to find the cells in a Sheet, and then copy from that Sheet. This is what I have so far (I have a couple of message boxes to see if the code was correctly looping through the sheets and finding something):
Sub PasteTemplate()
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
Dim Dest As Worksheet
Set Dest = ActiveSheet
Dim FindValue As String
FindValue = Range("B3").Value
Dim PasteHere As Range
Set PasteHere = Range("A5")
'This section opens wb2 if it is not already open
Dim fStatus As Long
Err.Clear
On Error Resume Next
Set wb2 = Application.Workbooks.Open(filename:="Templates.xlsx", UpdateLinks:=False)
fStatus = Err
On Error GoTo 0
If fStatus Then
Set wb2 = Application.Workbooks.Open(filename:="Templates.xlsx", UpdateLinks:=False)
End If
Dim FoundValue As Range
For Each Sheet In wb2.Sheets
With Sheet.Columns("B")
Set FoundValue = .Find(What:=FindValue, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
If FoundValue Is Nothing Then
msgbox "Value not found in " & Sheet.Name
End If
If Not FoundValue Is Nothing Then
msgbox "Found the value in " & Sheet.Name
Range("A1:Z100").Select '//Where the problem is. It selects the range in the sheet where wb2 was opened to
Application.CutCopyMode = False
Selection.Copy
End If
End With
Next
wb1.Activate
PasteHere.Select
ActiveSheet.Paste
End Sub
Just having Range(). is the same as having ActiveSheet.Range(). So it's always good to specify the sheet. This goes for the variables as well, like PasteHere
Also, the obligatory link to how to avoid using select.
Can't test it, but maybe something like this:
Since you are using a for each loop, we have the current sheet as a variable ready to use when referring to the range.
...
For Each Sheet In wb2.Sheets
With Sheet.Columns("B")
Set FoundValue = .Find(What:=FindValue, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
If FoundValue Is Nothing Then
msgbox "Value not found in " & Sheet.Name
End If
If Not FoundValue Is Nothing Then
msgbox "Found the value in " & Sheet.Name
Sheet.Range("A1:Z100").Copy PasteHere
End If
End With
Next
End Sub
I have a workbook that has 4 different sheets for inventory purposes (each sheet corresponds to a type of inventory to make organizing easier). Not the best setup, but I have a barcode lookup system where I scan the item's barcode and Excel finds and highlights the corresponding row (containing info like name, picture, quantity, etc.) that's all updated manually. Originally everything was on one sheet but recently I have sorted them out into 4 different sheets. Since then the barcode lookup only works on the original inventory sheet (makes sense since the code was only for that one sheet). I have been unable to figure out how to change the code to work on the whole workbook. I have tried to change worksheet to workbook (didn't work), then I tried to add a Set ws = ThisWorkbook.Sheets("") for each sheet (also didn't work) and a handful of other changes. If anyone has any idea on how to change it so it searches the workbook instead of the one sheet I would appreciate it.
Here is a copy of the working code for the first sheet:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Inventory List")
Dim rangeToLook As Range
Set rangeToLook = ws.Range("C3:C1000")
Dim wholeRange As Range
Set wholeRange = rangeToLook.Resize(, 10)
' change 14408667 to yours grey color code here
wholeRange.Cells.Interior.Color = 14408667
Dim code As Variant
code = InputBox("Please scan a barcode and hit enter if you need to")
Dim matchedCell As Range
Set matchedCell = rangeToLook.Find(what:=code, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=True)
If Not matchedCell Is Nothing Then
With matchedCell
Application.Goto .Cells(1)
.Resize(1, 10).Interior.ColorIndex = 20
End With
Else
MsgBox "Barcode Not Found"
End If
End Sub
Thank you for the help in advance.
Try this code:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim rangeToLook As Range
Dim wholeRange As Range
Dim code As Variant
Dim matchedCell As Range
code = InputBox("Please scan a barcode and hit enter if you need to")
For Each ws In ThisWorkbook.Sheets
Set rangeToLook = ws.Range("C3:C1000")
Set wholeRange = rangeToLook.Resize(, 10)
wholeRange.Interior.Color = 14408667
Set matchedCell = rangeToLook.Find(what:=code, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=True)
If Not matchedCell Is Nothing Then
With matchedCell
Application.Goto .Cells(1)
.Resize(1, 10).Interior.ColorIndex = 20
Exit For
End With
End If
Next
If matchedCell Is Nothing Then
MsgBox "Barcode Not Found"
End If
End Sub
Developing a code through which user selects a range in the active workbook. For the range selected i.e. A8:A12 i want to run a loop through which for each range in the selected range, the loop takes its value, Filters GL_Sheet's Current Region (GL_Rng) using that value and copy's the visible cells
The code is
'Declaring Workbooks
Dim GL_CY As Variant
Dim GL_Book As Workbook, Tgt_Book As Workbook
GL_CY = Application.GetOpenFilename(Title:="Open GL", FileFilter:="Excel Files (*.xls*),*xls*")
Set GL_Book = Application.Workbooks.Open(GL_CY)
Set Tgt_Book = Workbooks.Add
'Selecting Range
Dim GL_Code As Variant, GL_LR As Long, GL_Rng As range, Rng As range
Dim GL_Sheet As Worksheet, tgt As Worksheet
Set GL_Sheet = GL_Book.Worksheets(1)
GL_LR = GL_Sheet.range("B" & Rows.Count).End(xlUp).Row
Set GL_Rng = GL_Sheet.range("A4:R" & GL_LR).CurrentRegion.Offset(3, 0)
GL_Code = Application.InputBox(Prompt:="Select the range of GL codes to generate its GL activity ", Title:="Generate GL Activity", Type:=8)
' GL_Sheet.range("A3:A5").Value = range(GL_Code).Value
For Each Rng In range(GL_Code)
Set tgt = Tgt_Book.Worksheets.Add
GL_Rng.AutoFilter Field:=6, Criteria1:=GL_Code
GL_Rng.SpecialCells(xlCellTypeVisible).Copy
tgt.Paste
tgt.range("A1").CurrentRegion.Cut tgt.range("B6")
tgt.Cells.WrapText = False
tgt.Cells.Columns.AutoFit
tgt.Name = GL_Code
Application.CutCopyMode = False
Next Rng
As you can see I am struggling with the last part of the code which results in Error 1004 (Method of range...)
Naqi,
I created a little test routine to check out what was being returned from the InputBox.
Turns it was coming back as a Variant. I tried setting it as a Range but that wouldn't work either. However changing the Type:=2 (string) makes it work
Option Explicit
Sub Test()
Dim GL_Code As String
GL_Code = Application.InputBox(Prompt:="Select the range of GL codes to generate its GL activity ", _
Title:="Generate GL Activity", _
Type:=2)
Debug.Print Range(GL_Code).Address()
End Sub
'So by changing your Type to 2 the For Each rng statement should no longer create a problem.
Edit: Found an option using Type 8:
[Click here for the post I found this in.][1]
Sub MyMacro()
Dim GL_Code As Range
Set GL_Code = Application.InputBox("Select a range", "Get Range", Type:=8)
Debug.Print GL_Code.Address()
End Sub
'Since GL_Code is now a range your For Each should NOT enclose it in a Range() function!
HTH
I'm a beginner with an excel database and I want to be able to click a button and generate a csv from it so it can be in a format that can be fed into another SQL database (and also people will stop manually copying and pasting from it!).
The code I have - made with help from other forums- allows the bulk data to be copied over and a header to be generated.
Sub Button3_Click()
Dim srminsampls_test_csv As String
Dim Minsamps As Workbook
Dim CSV As Workbook
Dim copyRng As Range
Dim rng1 As Range
Dim rng2 As Range
Application.DisplayAlerts = False
On Error GoTo err
Set Minsamps = ThisWorkbook
srminsampls_test_csv = Minsamps.Path & "\" & "CSV-Exported-File-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
'to select and copy the assay data:'
Set rng1 = Cells.Find("", [C4], xlFormulas, xlByRows, xlPrevious)
Set rng2 = Cells.Find("", [F4], xlFormulas, xlByColumns, xlPrevious)
If Not rng1 Is Nothing Then
Set copyRng = Range([C4], Cells(rng1.Row, rng2.Column))
Else
MsgBox "sheet is blank", vbCritical
End If
copyRng.Copy
'create the new sheet
Set CSV = Application.Workbooks.Add(1)
With CSV
.Sheets(1).Range("A12").PasteSpecial xlPasteValues
'insert the csv header
.Sheets(1).Range("A1").Select
.Sheets(1).Range("A1").FormulaR1C1 = "Report_No"
.Sheets(1).Range("A2").Select
.Sheets(1).Range("A2").FormulaR1C1 = "No_Samples"
.Sheets(1).Range("A3").Select
.Sheets(1).Range("A3").FormulaR1C1 = "DATE_RECEIVED"
'etc etc...there are many many lines of similar code here!
'save and generate file
.SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
.Close
End With
err:
Application.DisplayAlerts = True
End Sub`
It allows the header to show DATE_RECEIVED, but I don't know how to copy over a value from the original sheet (Minsamps) and paste it into the cell next to DATE_RECEIVED. Whatever I do either stops the header and other copy/paste code from working or the whole sheet comes out blank. Sorry if this is very simple but I just can't seem to work it out.
Thanks,
EJ
Following changes / additions shall enable desired program execution.
In declarations please add following lines.
Dim ws As Worksheet 'Added worksheet variable
Dim dtrep As String 'Added date string variable
set value of date variable to original sheet Range("A4") value
Set ws = Minsamps.Worksheets(1)
dtrep = ws.Range("A4").Value 'set value of date variable to original sheet "A4"
Change following line
.Sheets(1).Range("A3").FormulaR1C1 = "DATE_RECEIVED"
To
.Sheets(1).Range("A3").FormulaR1C1 = "DATE_RECEIVED" & " - " & dtrep
Rest seems to be okay.
HTH
I have checked a bunch of different posts and can't seem to find the exact code I am looking for. Also I have never used VBA before so I'm trying to take codes from other posts and input my info for it to work. No luck yet. At work we have a payroll system in Excel. I am trying to search for my name "Clarke, Matthew" and then copy that row and paste it to the workbook I have saved on my desktop "Total hours".
CODE
Sub Sample()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim copyFrom As Range
Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
Dim strSearch As String
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("yourSheetName")
strSearch = "Clarke, Matthew"
With ws1
'~~> Remove any filters
.AutoFilterMode = False
'~~> I am assuming that the names are in Col A
'~~> if not then change A below to whatever column letter
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:A" & lRow)
.AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With
'~~> Remove any filters
.AutoFilterMode = False
End With
'~~> Destination File
Set wb2 = Application.Workbooks.Open("C:\Sample.xlsx")
Set ws2 = wb2.Worksheets("Sheet1")
With ws2
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
copyFrom.Copy .Rows(lRow)
End With
wb2.Save
wb2.Close
End Sub
SNAPSHOT
Expanding on what timrau said in his comment, you can use the AutoFilter function to find the row with your name in it. (Note that I'm assuming you have the source workbook open)
Dim curBook As Workbook
Dim targetBook As Workbook
Dim curSheet As Worksheet
Dim targetSheet As Worksheet
Dim lastRow As Integer
Set curBook = ActiveWorkbook
Set curSheet = curBook.Worksheets("yourSheetName")
'change the Field number to the correct column
curSheet.Cells.AutoFilter Field:=1, Criteria1:="Clarke, Matthew"
'The Offset is to remove the header row from the copy
curSheet.AutoFilter.Range.Offset(1).Copy
curSheet.ShowAllData
Set targetBook = Application.Workbooks.Open "PathTo Total Hours"
Set targetSheet = targetBook.WorkSheet("DestinationSheet")
lastRow = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
targetSheet.Cells(lastRow + 1, 1).PasteSpecial
targetBook.Save
targetBook.Close
As you can see I put placeholders in for the specific setup of your workbook.
I know this is old, but for anyone else searching for how to do this, it can be done in a much more direct fashion:
Public Sub ExportRow()
Dim v
Const KEY = "Clarke, Matthew"
Const WS = "Sheet1"
Const OUTPUT = "c:\totalhours.xlsx"
Const OUTPUT_WS = "Sheet1"
v = ThisWorkbook.Sheets(WS).Evaluate("index(a:xfd,match(""" & KEY & """,a:a,),)")
With Workbooks.Open(OUTPUT).Sheets(OUTPUT_WS)
.[1:1].Offset(.[counta(a:a)]) = v
.Parent.Save: .Parent.Close
End With
End Sub