On my Workbook, I have a sheet called "check"
Where the CELLS have the values:
F8 = 176129.20
H8 = 176129.20
My VBA code is a basic validation script which checks boths cells and displays messages based on the outcome.
Function plchk()
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets("check")
qb = sheet.Range("F8").Value
xl = sheet.Range("H8").Value
If qb = xl Then
plchk = "They're the same"
Else
plchk = qb & " " & xl
End If
End Function
Should be pretty straight forward when I compare qb = xl the THEN should be executed, however instead VBA doesn't recognise them as the same and goes down the ELSE route and outputs both numbers with a space, and they're exactly the same number. I'm lost! Variable types?
Whomever helps me i send out good karma to you inadvance!!
try this:
Function plchk()
Dim sheet As Worksheet, qb as double, xl as double
Set sheet = ActiveWorkbook.Sheets("check")
qb = cdbl(trim(sheet.Range("F8").Value))
xl = cdbl(trim(sheet.Range("H8").Value))
If qb = xl Then
plchk = "They're the same"
Else
plchk = qb & " " & xl
End If
End Function
Related
I'm trying to CopyPicture cells in Column B, and name them the value in Column 1. I have code that works, except it keeps giving the pictures the wrong names. The baffling thing is that sometimes it works perfectly, and other times it does not.
I have tried to cobble together a routine based on posted examples of the CopyPicture command. I'm pasting it in below.
Yes, I'm a newbie at VBScript. Be gentle. ;-)
Sub makepic()
Dim path As String
path = "C:\BP\BP2020\JPGs\"
Dim CLen As Integer
Dim cntr As Integer
cntr = 1
Dim rgExp As Range
Dim CCntr As String
CString2 = "A1:A6"
Set rgExp2 = Range(CString2)
CString = "B1:B6"
Set rgExp = Range(CString)
For I = 1 To rgExp.Cells.Count Step 1
CCntr = rgExp2.Cells(I).Value
rgExp.Cells.Cells(I).Font.Size = 72
rgExp.Cells.Cells(I).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
rgExp.Cells.Cells(I).Font.Size = 14
''' Create an empty chart with exact size of range copied
CLen = Len(rgExp.Cells.Cells(I).Value)
CWidth = CLen * 85
With ActiveSheet.ChartObjects.Add(Left:=1600, Top:=rgExp.Top, _
Width:=CWidth, Height:=50)
.Name = "ChartVolumeMetricsDevEXPORT"
.Activate
End With
''' Paste into chart area, export to file, delete chart.
If CCntr <> "" Then
ActiveChart.Paste
Selection.Name = "pastedPic"
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export (path + CCntr & ".jpg")
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete
End If
cntr = cntr + 1
Next
End Sub
Again, I expect -- for example -- a picture of the contents of cell B1 to have the name of the contents of A1. I tried making the range A1:B4 (for example), but that got me 8 pictures. I finally decided to try to make 2 ranges, but that didn't work either.
So I am writing a script to compare two excel files.
I'm using a For loop in the first workbook to get the references I want to find in the second workbook (6450 rows long so that no For loop, way to slow)
I have been looking for some way to use the VLOOKUP thing but i could not make it work Here is the code :
For i = 7 to numLines ''numLines is the number of used lines of the first workbook
If '''test to get out of the LOOP
objExcel.Workbooks(Str1).Sheets(1).Range("D"&i)="" AND objExcel.Workbooks(Str1).Sheets(1).Range("H"&i)="" AND objExcel.Workbooks(Str1).Sheets(1).Range("L"&i)="" Then
i = numLines
Else '' here i get the reference (the 6 first digits of the first workbook and I try to find it in the second)
If objExcel.Workbooks(Str1).Sheets(1).Range("D"&i)<>"" Then
Reference = Mid(objExcel.Workbooks(Str1).Sheets(1).Range("D"&i),1,6)
Set table_lookup = objExcel.Workbooks(Str1).Sheets(1).Range( "C1:C" & numLines2 )
cell = objExcel.Workbooks(Str2).WorksheetFunction.vlookup(Reference, table_lookup, 0, False)
MsgBox cell.row
MsgBox cell.column
End If
End If
Next
You have to switch to the "find" method instead of the vlookup that does not seem to work on vba
For i = 7 to numLines
If objExcel.Workbooks(Str1).Sheets(1).Range("D"&i)="" AND objExcel.Workbooks(Str1).Sheets(1).Range("H"&i)="" AND objExcel.Workbooks(Str1).Sheets(1).Range("L"&i)="" Then
i = numLines
Else
If objExcel.Workbooks(Str1).Sheets(1).Range("D"&i)<>"" Then
Reference = Mid(objExcel.Workbooks(Str1).Sheets(1).Range("D"&i),1,6)
Set r = objExcel.Workbooks(Str2).Sheets(1).Range( "C1:C" & numLines2 )
Set matched = r.Find(Reference)
If Not r.Find(Reference) Is Nothing Then
objExcel.Workbooks(Str1).Sheets(1).Range("R"&i).Value = matched.Offset(0,0).Value
objExcel.Workbooks(Str1).Sheets(1).Range("S"&i).Value = matched.Offset(0,1).Value
objExcel.Workbooks(Str1).Sheets(1).Range("T"&i).Value = matched.Offset(0,2).Value
objExcel.Workbooks(Str1).Sheets(1).Range("U"&i).Value = matched.Offset(0,3).Value
objExcel.Workbooks(Str1).Sheets(1).Range("V"&i).Value = matched.Offset(0,6).Value
End If
End If
End If
Next
I have 3 sheets, in sheet one I have a column "Register Codes" and I have extracted the unique codes in next column. Please check the below image.
Based on these unique codes, sub-codes are allocated in sheet 2. please check the below image.
Now what I am trying here is that in sheet 3 I need every "Register code" with the relevant "sub-code" which is allocated in sheet2 based on the "unique ID" given in Sheet1. please check the below image for expected output.
I have been using various combinations of formulas but could not get a proper solution. What is the best way to do it in VBA as I just started learning in this field.
Subject to a few conditions the following code will do what you want. Install it in a standard code module (by default "Module1", but you can name it as you like) in the workbook where you have your data.
Option Explicit
Enum Nws ' Worksheet navigation
NwsFirstDataRow = 2 ' presumed the same for all worksheets
NwsCode = 1 ' 1 = column A (change as required)
NwsSubCode ' No value means previous + 1
NwsNumer
End Enum
Sub NumerList()
' 05 Apr 2017
Dim Wb As Workbook ' all sheets are in the same workbook
Dim WsCodes As Worksheet ' Register codes
Dim WsNum As Worksheet ' Sub-code values
Dim WsOut As Worksheet ' Output worksheet
Dim RegName As String, RegCode As String
Dim Sp() As String
Dim Rs As Long ' Source row in WsNum
Dim Rt As Long ' Target row in WsOut
Dim R As Long, Rl As Long ' rows / Last row in WsCodes
Set Wb = ActiveWorkbook ' Make sure it is active!
Set WsCodes = Wb.Worksheets("Reg Codes") ' Change name to your liking
Set WsNum = Wb.Worksheets("Code Values") ' Change name to your liking
On Error Resume Next
Set WsOut = Wb.Worksheets("Output") ' Change name to your liking
If Err Then
Set WsOut = Wb.Worksheets.Add(After:=WsNum)
WsOut.Name = "Output" ' create the worksheet if it doesn't exist
End If
On Error GoTo 0
Rt = NwsFirstDataRow
With WsCodes
Rl = .Cells(.Rows.Count, NwsCode).End(xlUp).Row
For R = NwsFirstDataRow To Rl
RegName = .Cells(R, NwsCode).Value
Sp = Split(RegName, "-")
If UBound(Sp) > 1 Then ' must find at least 2 dashes
RegCode = Trim(Sp(1))
Else
RegCode = ""
End If
If Len(RegCode) Then
On Error Resume Next
Rs = WorksheetFunction.Match(RegCode, WsNum.Columns(NwsCode), 0)
If Err Then Rs = 0
On Error GoTo 0
If Rs Then
Do
WsOut.Cells(Rt, NwsCode).Value = RegName
WsOut.Cells(Rt, NwsSubCode).Value = WsNum.Cells(Rs, NwsSubCode).Value
WsOut.Cells(Rt, NwsNumer).Value = WsNum.Cells(Rs, NwsNumer).Value
Rt = Rt + 1
Rs = Rs + 1
Loop While WsNum.Cells(Rs, NwsCode).Value = RegCode
Else
RegCode = ""
End If
End If
If Len(RegCode) = 0 Then
WsOut.Cells(Rt, NwsCode).Value = RegName
WsOut.Cells(Rt, NwsSubCode).Value = "No sub-code found"
Rt = Rt + 1
End If
Next R
End With
End Sub
And here are the conditions.
All 3 sheets must be in the same workbook. If you have them in different workbooks the code must be adapted to handle more than one workbook.
The two worksheets with data must exist. They must be named as the code prescribes or the code must be modified to match the names they have. The same goes for the Output worksheet, but that sheet will be created by the code if it doesn't exist. You can change its name in the code.
The enumeration at the top of the code presumes that all 3 sheets are identically formatted with no data in row 1 (captions) and data in columns A, B and C. Changes aren't difficult but must be made if you want a different input or output. You can change the columns in the existing code by assigning other values to the columns in the enum, but the code requires the same arrangement in all sheets.
The extracted codes in the Codes sheet aren't used. The code does its own extraction. It will mark an error in the output list if a code can't be extracted or if it isn't found in the Sub-code list.
The sub-codes in the Numer sheet must be sorted like the picture you posted. The code will look for the first occurrence of "image" and find the subcodes in the following rows while the code is "image" in column A. It will not find further occurrences of "image" that might follow after an intermission.
The code doesn't do any colouring. Adding it wouldn't be difficult, but you would have to specify some rules, such as "20 different colours for the first 20 codes and then repeat the same sequence".
Other cell formatting could be added without much effort because each cell is already individually named. More properties can be added easily.
I am writing a macro that will sit in workbook A.
Workbook A's primary function will be to open workbooks 1-5, and run the macros in those workbooks. However in order to run the macros in workbooks 1-5 I will need to pass inputs to workbooks 1-5 from workbook A.
I would like to define a dictionary or an object in workbook A, which will pass an entire set of inputs to each workbook 1-5. And the macros in workbooks 1-5 will only grab the necessary inputs.
How can I acheive this?
I'm wary of the vagueness of "run the macros in those workbooks", but I'll proceed with caution... :)
Let's say you have your workbooks, Master.xls and Child1-3.xls. They all have a reference set to the Windows Scripting Runtime library.
Master has a Settings worksheet and some VBA
Child1-3 each have two worksheets, DataDump and Settings
Child1-3 each have a public module with a VBA proc to be run (name is known)
The Master Settings w/s is populated thusly:
A1 = SettingName B1 = SettingValue
A2 = Setting1 B2 = Value1
A3 = Setting2 B3 = Value2
A4 = Setting3 B4 = Value3
(note that column C is empty and E always has a trailing \)
D1 = WBName E1 = WBPath F1 = ProcName
D2 = Child1.xls E2 = C:\Temp\ F2 = MaryJo
D3 = Child2.xls E3 = C:\Temp\ F3 = MaryLou
D4 = Child3.xls E4 = C:\Temp\ F4 = DaisyLou
There's the setup, now the execution.
Within a proc ("Bob") in Master write something like this:
Public Sub Bob
Dim dctSetting As Dictionary
Dim wkbCurrent As Workbook
Dim rngWkbook As Range
Dim rngSetting As Range
Set rngSetting = ThisWorkbook.Worksheets("Sheet1").Range("A2")
Set dctSetting = New Dictionary
Do Until rngSetting = ""
dctSetting.Add rngSetting.Value, rngSetting.Offset(0, 1).Value
Loop
Set rngWkBook = ThisWorkbook.Worksheets("Sheet1").Range("D2")
Do Until rngWkBook.Value = ""
Set wkbCurrent = Workbooks.Open(rngWkBook.Offset(0,1) & rngWkBook)
Application.Run "'" & rngWkBook & "'!" & rngWkBook.Offset(0,2),
dctSetting
Set wkbCurrent.Saved = True
wkbCurrent.Close False
Set rngWkBook = rngWkBook.Offset(1,0)
Loop
End Sub
Each of Child1-3 has their respective procs (MaryJo, MaryLou, DaisyLou), with the limitation of this approach being that each of those procs has to accept one param (best to make it a dictionary, I guess).
Each child's proc doesn't have to use all three settings, or even any of them. By using a dictionary, you can check for the existence of a setting prior to using it. So in each of the child procs there would be something like:
Public Sub MaryLou(dctSettings as Dictionary)
Dim strMyValue As String
If dctSettings.Exists("TheNameOfTheMasterSettingIWantToUse") Then
strMyValue = dctSettings("TheNameOfTheMasterSettingIWantToUse")
' Your code runs here with the populated variable
End If
End Sub
You'll need to do extra stuff like check for the child w/b at the specified path - at a bare minimum!
I want to outline the chart data range source(s) in a table, in much the same way that the GUI will outline a range in blue if the chart data series is clicked. The user can choose various chart views and the range highlight colours for each data series need to match those displayed in the chart.
For the record, here are the methods I considered:
Parse the chart series values string and extract the data range
Do a lookup on a table that stores information on the ranges and the colours to be used
In the end I went with option 2 as is seemed easier to implement and to properly manage the colours I would probably have to store them for method 1 anyway, negating its benefits.
The highlight procedure is called from the Worksheet_Change event, a lookup is done on the chart name, the ranges and colours pulled from the table and then the cell formatting is carried out. The limitation of this method is that the range/colour data for each new chart view must be pre-calculated. This isn't much of a problem for my current implementation, but my be a limiting factor in future use where the charts might be more dynamic.
So although I've got a version of this working fine, I'm sure there must be a more elegant way of achieving this.
Any suggestions?
Edit:
OK, this seems to handle more cases better. The triggering code is the same, but here is new code for the module:
Function SeriesRange(s As Series) As Range
Dim sf As String, fa() As String
sf = s.Formula
sf = Replace(sf, "=SERIES(", "")
If sf = "" Then
Set SeriesRange = Nothing
Exit Function
End If
fa = Split(sf, ",")
Set SeriesRange = Range(fa(2))
End Function
Sub x(c As Chart)
Dim sc As Series
Dim sr As Range
If SeriesRange(c.SeriesCollection(1)) Is Nothing Then
Exit Sub
End If
Set sr = SeriesRange(c.SeriesCollection(1))
sr.CurrentRegion.Interior.ColorIndex = xlNone
For Each sc In c.SeriesCollection
If sc.Interior.Color > 1 Then
SeriesRange(sc).Interior.Color = sc.Interior.Color
ElseIf sc.Border.ColorIndex > 1 Then
SeriesRange(sc).Interior.Color = sc.Border.Color
ElseIf sc.MarkerBackgroundColorIndex > 1 And sc.MarkerBackgroundColorIndex < 57 Then
SeriesRange(sc).Interior.ColorIndex = sc.MarkerBackgroundColorIndex
ElseIf sc.MarkerForegroundColorIndex > 1 And sc.MarkerForegroundColorIndex < 57 Then
SeriesRange(sc).Interior.ColorIndex = sc.MarkerForegroundColorIndex
Else
MsgBox "Unable to determine chart color for data series " & sc.Name & " ." & vbCrLf _
& "It may help to assign a color rather than allowing AutoColor to assign one."
End If
Next sc
End Sub
/Edit
This is probably more barbaric than elegant, but I think it does what you want. It involves your first bullet point to get the range from the Series object, along with a sub to run through all the Series objects in the SeriesCollection for the chart. This is activated on Chart_DeActivate. Most of this code is jacked - see comments for sources.
In a module:
Function SeriesRange(s As Series) As Range
Dim sf As String, fa() As String
Dim i As Integer
Dim result As Range
sf = s.Formula
sf = Replace(sf, "=SERIES(", "")
fa = Split(sf, ",")
Set SeriesRange = Range(fa(2))
End Function
Sub x(c As Chart)
Dim sc As Series
Dim sr As Range
Set sr = SeriesRange(c.SeriesCollection(1))
sr.CurrentRegion.Interior.ColorIndex = xlNone
For Each sc In c.SeriesCollection
SeriesRange(sc).Interior.Color = sc.Interior.Color
Next sc
End Sub
In the ThisWorkbook object module:
' Jacked from C Pearson http://www.cpearson.com/excel/Events.aspx '
Public WithEvents CHT As Chart
Private Sub CHT_Deactivate()
x CHT
End Sub
Private Sub Workbook_Open()
Set CHT = Worksheets(1).ChartObjects(1).Chart
End Sub
Have you tried using Conditional Formatting?