I'm working on a program with Excel's VBA functionality, but ran into a very strange logic error.
For SheetIndex = 1 To 6
With ActiveSheet
For ColIndex = 2 To 6
For DateIndex = 0 To MinLimit
datethingy = .Cells(1, ColIndex).Value
If (.Cells(1, ColIndex).Value = Date_Array(DateIndex, 1)) Then
For RowIndex = 2 To 11
' Compare every time slot value here to every time slot value in the array
datethingy = Trim(CStr(.Cells(RowIndex, 1).Value)) 'ERROR OCCURS HERE
If (Trim(CStr(.Cells(RowIndex, 1).Value)) = Date_Array(DateIndex, 2)) Then
.Cells(RowIndex, ColIndex).Value = "Checked"
End If
Next
End If
Next
Next
End With
SheetIndex = SheetIndex + 1
Application.Worksheets(SheetIndex).Activate
Next
So in the code above, I go through a series of cell values and make comparisons to values I already have in my array. However, when I draw the values from the cells, rather than "8:30", it comes up as "0.354166666...7". I have no idea why it's coming up like this, I'm even making sure it's being compared as a string and not as an int or anything else.
Here is where I set the values for the sheet's cells.
.Cells(2, 1).Value = "8:30"
.Cells(3, 1).Value = "9:00"
.Cells(4, 1).Value = "10:15"
.Cells(5, 1).Value = "11:30"
.Cells(6, 1).Value = "12:30"
.Cells(7, 1).Value = "13:30"
.Cells(8, 1).Value = "14:45"
.Cells(9, 1).Value = "16:00"
.Cells(10, 1).Value = "17:15"
.Cells(11, 1).Value = "18:15"
With Range("A2", "A11")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.ColumnWidth = 15
End With
ActiveSheet.Cells.Rows.AutoFit
Does anyone have any idea why this could be happening?
Excel stores times and dates as numbers. Each whole number is a day and hours, minutes and seconds are broken down as fractions of that day. 8:30 is just a time so there is no whole number and 8.5/24 = 0.3541667.
You can test this with this code and this may provide you a way to format your inputs. Type 8:30 into cell A1
Sub test()
Debug.Print sheet1.Range("A1").Value = "8:30" 'returns false
Debug.Print Format(sheet1.Range("A1").Value, "h:mm") = "8:30" 'returns true
Debug.Print Sheet1.Range("A1").Text = "8:30" 'return true
End Sub
Related
I am getting an error in the macro I'm working on for a bootcamp project. The idea is that I have refactored the code to make it more efficient, but I'm getting an Overflow error on one of the lines. I think it's due to it trying to divide 0, but I don't know where I've gone wrong in the loop that it is pulling data that would divide by 0. Any ideas? I'm getting the error on this line
Cells(4 + i, 3).Value = EndingPrices(i) / StartingPrices(i) - 1
in section 4 - '4) Loop through your arrays to output the Ticker, Total Daily Volume, and Return.
Sub AllStocksAnalysisRefactored()
Dim startTime As Single
Dim endTime As Single
yearValue = InputBox("What year would you like to run the analysis on?")
startTime = Timer
'Format the output sheet on All Stocks Analysis worksheet
Worksheets("All Stocks Analysis").Activate
Range("A1").Value = "All Stocks (" + yearValue + ")"
'Create a header row
Cells(3, 1).Value = "Ticker"
Cells(3, 2).Value = "Total Daily Volume"
Cells(3, 3).Value = "Return"
'Initialize array of all tickers
Dim tickers(12) As String
tickers(0) = "AY"
tickers(1) = "CSIQ"
tickers(2) = "DQ"
tickers(3) = "ENPH"
tickers(4) = "FSLR"
tickers(5) = "HASI"
tickers(6) = "JKS"
tickers(7) = "RUN"
tickers(8) = "SEDG"
tickers(9) = "SPWR"
tickers(10) = "TERP"
tickers(11) = "VSLR"
'Activate data worksheet
Worksheets(yearValue).Activate
'Get the number of rows to loop over
RowCount = Cells(Rows.Count, "A").End(xlUp).Row
'1a) Create a ticker Index
Dim tickerIndex As Integer
tickerIndex = 0
'1b) Create three output arrays
Dim tickerVolumes(12) As Long
Dim StartingPrices(12) As Long
Dim EndingPrices(12) As Long
''2a) Create a for loop to initialize the tickerVolumes to zero.
For i = 0 To 11
tickerVolumes(i) = 0
Next i
''2b) Loop over all the rows in the spreadsheet.
For i = 2 To RowCount
'3a) Increase volume for current ticker
If Cells(i, 1).Value = tickerIndex Then
tickerVolumes(tickerIndex) = tickerVolumes(tickerIndex) + Cells(i, 8).Value
End If
'3b) Check if the current row is the first row with the selected tickerIndex.
'If Then
If Cells(i, 1) = tickerIndex And Cells(i - 1, 1).Value <> tickerIndex Then
StartingPrices(tickerIndex) = Cells(i, 6).Value
End If
'End If
'3c) check if the current row is the last row with the selected ticker
'If the next row’s ticker doesn’t match, increase the tickerIndex.
'If Then
If Cells(i, 1).Value = tickerIndex And Cells(i + 1, 1) <> tickerIndex Then
EndingPrices(tickerIndex) = Cells(i, 6).Value
'3d Increase the tickerIndex.
tickerIndex = tickerIndex + 1
End If
'End If
Next i
'4) Loop through your arrays to output the Ticker, Total Daily Volume, and Return.
For i = 0 To 11
Worksheets("All Stocks Analysis").Activate
tickerIndex = i
Cells(4 + i, 1).Value = tickers(i)
Cells(4 + i, 2).Value = tickerVolumes(i)
Cells(4 + i, 3).Value = EndingPrices(i) / StartingPrices(i) - 1 ' **this line is causing the error**
Next i
'Formatting
Worksheets("All Stocks Analysis").Activate
Range("A3:C3").Font.FontStyle = "Bold"
Range("A3:C3").Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("B4:B15").NumberFormat = "#,##0"
Range("C4:C15").NumberFormat = "0.0%"
Columns("B").AutoFit
dataRowStart = 4
dataRowEnd = 15
For i = dataRowStart To dataRowEnd
If Cells(i, 3) > 0 Then
Cells(i, 3).Interior.Color = vbGreen
Else
Cells(i, 3).Interior.Color = vbRed
End If
Next i
endTime = Timer
MsgBox "This code ran in " & (endTime - startTime) & " seconds for the year " & (yearValue)
End Sub
This is such a basic program, but I'm obviously doing something wrong. I have a spreadsheet with numeric values in all Cells, then I am comparing three totals, the first is a SUM of the 10 cells above it, the next is retrieved from SSMS and the third is captured from screenshots by Snagit. These should, and mostly are, all be the same …
The program Hides all the Columns then scrolls through them and UnHides them if there is a MisMatch in the Total Fields. Except it doesn't, it says there is a problem in almost every Column !!! If someone can please explain and / or help then you may just save my sanity !!!
Sub FindMisMatches()
Columns("B:EE").Select
Selection.EntireColumn.Hidden = True
Dim SUMvalue As Variant
Dim SQLvalue As Variant
Dim COBOLvalue As Variant
Dim MisMatch As String
For i = 2 To 135
MisMatch = "No"
Cells(15, i).Value = ""
SUMvalue = Cells(12, i).Value
SQLvalue = Cells(13, i).Value
COBOLvalue = Cells(14, i).Value
If SUMvalue = SQLvalue Then
'do nothing
Else
MisMatch = "Yes"
End If
If SUMvalue = COBOLvalue Then
'do nothing
Else
MisMatch = "Yes"
End If
If SQLvalue = COBOLvalue Then
'do nothing
Else
MisMatch = "Yes"
End If
If MisMatch = "Yes" Then
Cells(15, i).Value = "XXXXX"
Cells(12, i).Interior.ColorIndex = 3
Cells(13, i).Interior.ColorIndex = 3
Cells(14, i).Interior.ColorIndex = 3
Cells(15, i).Select
ActiveCell.EntireColumn.Hidden = False
End If
Next i
End Sub
I am looking for a way to shorten my code to input data from a form of 10 entries.
This is my userform with one RMA number (applies to all 10 PN), one customer name, 10 part numbers, and 10 serial numbers that go with each part number.
This is how I want data transferred to the worksheet.
The part number textboxes are named TB#.
The serial number textboxes are named SNTB#.
This is the code I have for the first entry. I was thinking of adding code to say "TB"&"i" and "SNTB"&"i", but I don't know where to place that statement or how to start it.
Private Sub EnterButton_Click()
'this assigns receiving data to first columns of log Sheet
If TB1.Value = "" Then
Else
Worksheets("RM Tracker").Activate
Dim lastrow
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = RMATB.Value
Cells(lastrow, 2) = CustCB.Value
Cells(lastrow, 3) = TB1.Value
Cells(lastrow, 4) = SNTB1.Value
Cells(lastrow, 5) = ReceiveTB.Value
ActiveCell.Offset(1, 0).Select
End If
ActiveWorkbook.Save
Call resetform
End Sub
Sub resetform()
RMATB.Value = ""
CustCB.Value = ""
TB1.Value = ""
SNTB1.Value = ""
ReceiveTB = ""
'sets focus on that first textbox again
RecForm.RMATB.SetFocus
End Sub
You can incorporate a for loop where "i" represents the row you are working with. When you are appending data you need to put that reference within the loop so the new row is recalculated.
Private Sub EnterButton_Click()
'this assigns receiving data to first columns of log Sheet
If TB1.Value = "" Then
Else
Worksheets("RM Tracker").Activate
dim i as long
For i = 1 To 10
Dim lastrow as long ' should put a data type with dim statements
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = Userform1.Controls("RMATB" & i).Value ' change userform name to fit your need
Cells(lastrow, 2) = Userform1.Controls("CustCB" & i).Value
Cells(lastrow, 3) = Userform1.Controls("TB1" & i).Value
Cells(lastrow, 4) = Userform1.Controls("SNTB1" & i).Value
Cells(lastrow, 5) = Userform1.Controls("ReceiveTB" & i).Value
Next i
End If
ActiveWorkbook.Save
Call resetform
End Sub
Sub resetform()
RMATB.Value = ""
CustCB.Value = ""
TB1.Value = ""
SNTB1.Value = ""
ReceiveTB = ""
'sets focus on that first textbox again
RecForm.RMATB.SetFocus
I am trying to compare values in two lists. I want my code to compare a value in the first list and check all the entries in the second list. If there is a match then the code will print true next to the value in the first list and if not it will print false.
The problem I am having is that my code only compares values that are in the same row.
The code runs and I have tried it on a two smaller lists to make sure the data types are to same and there aren't any extra spaces or commas in the lists that would lead to a "False" output. I have also tried changing the order of the for and if statements but this doesn't work either.
Sub findvalues()
For i = 2 To 16
For j = 2 To 16
If Cells(i, 3).Value = Cells(i, 1).Value Then
Cells(i, 4).Value = "TRUE"
ElseIf Cells(i, 3).Value = Cells(j + 1, 1).Value Then
Cells(i, 4).Value = "TRUE"
Else
Cells(i, 4).Value = "FALSE"
End If
Next j
Next i
End Sub
Here are the two lists I am testing the code on
Slight mods to your code based on the data you provided in columns 1 & 3. As always, things could be improved but this should get you going ...
Sub findvalues()
Dim i As Long, j As Long, bResult As Boolean
For i = 2 To 16
strValueToLookFor = Cells(i, 1)
For j = 2 To 16
bResult = False
If strValueToLookFor = Cells(j, 3).Value Then
bResult = True
Exit For
End If
Next j
Cells(i, 6).Value = bResult
Next i
End Sub
... you may just need to flick the columns over so the first list searches on the second list or vice versa.
I don't see any need for VBA - formulas are the way to go - but to avoid two loops one could do this:
Sub findvalues()
Dim i As Long
For i = 2 To 130
Cells(i, 4).Value = IsNumeric(Application.Match(Cells(i, 1).Value, Range("C2:C130"), 0))
Next i
End Sub
Update: this does not cater for multiple matches.
There are many was to achieve that. one of them is by using IF & COUNTIF
Formula
=IF(COUNTIF($E$2:$E$6,A2)>0,"TRUE","FALSE")
Results:
VBA CODE
Option Explicit
Sub findvalues()
Dim i As Long
Dim rng As Range
With ThisWorkbook.Worksheets("Sheet1") 'Change if needed
Set rng = .Range("A2:A130") 'set rng to includes values from column A, rows 2:130
For i = 2 To 130 'Loop from row 2 to 130
'Check if the values in column C includes in the rng
If Application.WorksheetFunction.CountIf(rng, .Range("C" & i).Value) > 0 Then
.Range("D" & i).Value = "TRUE"
Else
.Range("D" & i).Value = "FALSE"
End If
Next i
End With
End Sub
VBA code to reconcile two lists.
Sub Reconciliation()
Dim endRow As Long
Dim ICount As Long
Dim Match1() As Variant
Dim Match2() As Variant
Dim ws As Worksheet
Set ws = Worksheets("Recon")
ICount = 0
endRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
endRow1 = ws.Cells(ws.Rows.Count, 11).End(xlUp).Row
Match1 = Sheet1.Range("b2:b" & endRow)
Match2 = Sheet1.Range("K2:K" & endRow1)
For i = LBound(Match1) To UBound(Match1)
For j = LBound(Match2) To UBound(Match2)
If Match1(i, 1) = Match2(j, 1) Then
ICount = ICount + 1
Sheet1.Range("C" & i + 1).Value = ICount
Sheet1.Range("L" & j + 1).Value = ICount
Else
End If
Next j
Next i
End Sub
I have a sheet that I collect the webpage data with columns from A:F
I want to put the old data in column E, from T column and onwards for each time I run the VBA module
I did for now something like
wks.Cells(i, "T").Value = wks.Cells(i, "E").Value
How can I make it to advace each time?
The full code is the following
For i = 2 To 17
LRandomNumber = Int((15 - 2 + 1) * Rnd + 2)
mylink = wks.Cells(i, 2).Value
ie.Navigate mylink
While ie.Busy Or ie.ReadyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
wks.Range(Cells(i, 1), Cells(i, 5)).Interior.ColorIndex = 38
Set price = ie.Document.querySelector(".price-container .final-price")
myprice = CCur(price.innerText)
checkprice = myprice * 1.24
'FORMAT PRICE
If wks.Cells(i, "E").Value < checkprice Then wks.Cells(i, "E").Interior.ColorIndex = 3 Else wks.Cells(i, "E").Interior.ColorIndex = 4
wks.Cells(i, "E").Value = myprice * 1.24
Set availability = ie.Document.querySelector(".inner-box-one .availability")
wks.Cells(i, "D").Value = availability.innerText
Set product_name = ie.Document.querySelector(".title-container h1.title")
wks.Cells(i, "C").Value = product_name.innerText
If Timer - t > LRandomNumber Then Exit Do
On Error GoTo 0
Loop
If price Is Nothing Then Exit Sub
wks.Range(Cells(i, 1), Cells(i, 5)).Interior.ColorIndex = 0
Next i
We need to put
'COPY PRICE
Call TransferDataFromColumnE(wks)
Outside the For loop
Untested, but I think you could determine the last column containing data by:
Dim lastColumn as long
lastColumn = wks.cells(1, wks.columns.count).end(xltoleft).column
lastColumn = application.max(lastColumn + 1, wks.columns("T").column)
' The Application.Max is meant to guarantee you either write to column T or any column to the right of it.
' +1 is so that we don't overwrite the last column, but instead write to the column after it.
Then you could continue with your code (although it might be better/quicker to assign the entire range/column in one go rather than each cell/row individually).
wks.Cells(i, lastColumn).Value = wks.Cells(i, "E").Value
Edit: Here's a tested example. Say I have some data in column E starting on row 2 on a sheet called "Sheet2".
I can use the code below to copy-paste it to the last column (where the last column is either column T or the first empty column to the right of it).
Option Explicit
Sub TransferDataFromColumnE()
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets("Sheet2")
Dim lastColumn As Long
lastColumn = wks.Cells(2, wks.Columns.Count).End(xlToLeft).Column
lastColumn = Application.Max(lastColumn + 1, wks.Columns("T").Column)
With wks.Range("E2:E24") ' This is the range I need to copy in my case
Dim columnOffset As Long
columnOffset = lastColumn - .Columns(1).Column
.Copy
.Offset(0, columnOffset).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End With
End Sub
And this is what I get after I've run the code three times -- which I think is what you want.