Error in Excel VBA code - excel

I am having a problem with my code, a compile error "type mismatch". Especially in the following line
If comp.Cells(r, c) = "" Then
i tried switching r and c with a number separately and it worked, but not together. Here's the full code
Sub missing_data()
Dim comp As Worksheet
Set comp = Sheets("Compiled")
empty_cells = 0
sixten_comp = 0
For r = 2 To 103
For c = 5 To 18
'searching for empty cells
If comp.Cells(r, c) = "" Then
If (c + 1998) > comp.Cells(r, 3) Then
empty_cells = empty_cells + 1
comp.Cells(r, c).Interior.ColorIndex = 13
'If comp.Cells(r, 1).Interior.ColorIndex = 1 Then sixten_comp = sixten_comp + 1
End If
End If
Next c
Next r
MsgBox "Number of total cells left is " & empty_cells
'MsgBox "Number of total cells left in 16 companies is " & sixten_comp
End Sub


The cells you are checking may contain an error returned by a formula so add another condition to check if the cell doesn't contain an error and if not, proceed to check other conditions....
If Not IsError(comp.Cells(r, c)) Then
If comp.Cells(r, c) = "" Then
If (c + 1998) > comp.Cells(r, 3) Then
empty_cells = empty_cells + 1
comp.Cells(r, c).Interior.ColorIndex = 13
'If comp.Cells(r, 1).Interior.ColorIndex = 1 Then sixten_comp = sixten_comp + 1
End If
End If
End If


Try:
If comp.Cells(r, c).Value = "" Then
instead of:
If comp.Cells(r, c) = "" Then
it should work without a problem

Related

How to make a cell reference function

Sub Nowe
X = 1
For i = 1 to 5
If Cells (i, X).Value = "What" Then
Cells (i+1, 6).Interior.ColorIndex = 6
End If
Next i
End Sub
I am showing an error on this snippet: "If Cells (i, X).Value = "What" Then"
I would like to make a reference but as functions

When I tried to run your code, the only error I got was related to not declaring x and i variables.
Option Explicit
Sub Nowe()
Dim x As Integer
Dim i As Integer
x = 1
For i = 1 To 5
If Cells(i, x).Value = "What" Then
Cells(i + 1, 6).Interior.ColorIndex = 6
End If
Next i
End Sub

Code works with two products but when I add a third product code grabs data but doesn't save it only for third product. What's wrong with it?

The code still works for oil and gas. It will find and pull in the refined data, I can see it on the current prices worksheet while it's running but when it's finished running it will delete the refined data and doesn't populate any of the other sheets for refined only. I copied all code bits for oil and replaced the word oil with refined.
Sub Prices()
Dim asOfDate As Date
Dim i, c, r As Integer
Dim break As Integer
Dim wf As WorksheetFunction
ws_currentprices.Activate
'Copy date from summary ws to pop asofdate
Cells(ASOFDATE_ROW, BUCKET_COL) = ws_summary.Cells(1, 6)
If IsEmpty(Cells(ASOFDATE_ROW, BUCKET_COL)) Then
asOfDate = Date
Else
asOfDate = Cells(ASOFDATE_ROW, BUCKET_COL)
End If
'Setting to manual calculation must happen after asofdate has been populated
Application.Calculation = xlManual
'Clear all data and headers from the current prices ws
Range(Cells(STATUS_ROW, FIRSTDATA_COL), Cells(110, 50)).ClearContents
Set wf = Application.WorksheetFunction
'Build arraylist of gas markets
Dim gasArray As Object
Set gasArray = CreateObject("System.Collections.ArrayList")
i = 1
Do Until (IsEmpty(ws_gasmarkets.Cells(i, 4)))
If StrComp(ws_gasmarkets.Cells(i, 4), "Yes", vbTextCompare) = 0 Then gasArray.Add ws_gasmarkets.Cells(i, 2).Value
i = i + 1
Loop
'Process arraylist of gas markets
c = FIRSTDATA_COL
For i = 0 To gasArray.Count - 1
Days = 0
Do Until Month(wf.WorkDay(asOfDate, Days)) <> Month(asOfDate)
Cells(COMMODITY_ROW, c) = gasArray(i)
Cells(ASOFDATE_ROW, c) = CDate(wf.WorkDay(asOfDate, Days))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Gas"
break = c - 1
c = c + 1
Days = Days - 1
Loop
Cells(COMMODITY_ROW, c) = gasArray(i)
Cells(ASOFDATE_ROW, c) = dhLastDayInMonth(DateSerial(Year(asOfDate), Month(asOfDate) - 1, 1))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Gas"
break = c - 1
c = c + 1
Next
'Build arraylist of oil markets
Dim oilArray As Object
Set oilArray = CreateObject("System.Collections.ArrayList")
i = 1
Do Until (IsEmpty(ws_oilmarkets.Cells(i, 4)))
If StrComp(ws_oilmarkets.Cells(i, 4), "Yes", vbTextCompare) = 0 Then oilArray.Add ws_oilmarkets.Cells(i, 2).Value
i = i + 1
Loop
'Process arraylist of oil markets
For i = 0 To oilArray.Count - 1
Days = 0
Do Until Month(wf.WorkDay(asOfDate, Days)) <> Month(asOfDate)
Cells(COMMODITY_ROW, c) = oilArray(i)
Cells(ASOFDATE_ROW, c) = CDate(wf.WorkDay(asOfDate, Days))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Oil"
break = c - 1
c = c + 1
Days = Days - 1
Loop
Cells(COMMODITY_ROW, c) = oilArray(i)
Cells(ASOFDATE_ROW, c) = dhLastDayInMonth(DateSerial(Year(asOfDate), Month(asOfDate) - 1, 1))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Oil"
break = c - 1
c = c + 1
Next
'Build arraylist of REFINED markets
Dim REFINEDArray As Object
Set REFINEDArray = CreateObject("System.Collections.ArrayList")
i = 1
Do Until (IsEmpty(ws_REFINEDmarkets.Cells(i, 4)))
If StrComp(ws_REFINEDmarkets.Cells(i, 4), "Yes", vbTextCompare) = 0 Then REFINEDArray.Add ws_REFINEDmarkets.Cells(i, 2).Value
i = i + 1
Loop
'Process arraylist of REFINED markets
For i = 0 To REFINEDArray.Count - 1
Days = 0
Do Until Month(wf.WorkDay(asOfDate, Days)) <> Month(asOfDate)
Cells(COMMODITY_ROW, c) = REFINEDArray(i)
Cells(ASOFDATE_ROW, c) = CDate(wf.WorkDay(asOfDate, Days))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "REFINED"
break = c - 1
c = c + 1
Days = Days - 1
Loop
Cells(COMMODITY_ROW, c) = REFINEDArray(i)
Cells(ASOFDATE_ROW, c) = dhLastDayInMonth(DateSerial(Year(asOfDate), Month(asOfDate) - 1, 1))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Refined"
break = c - 1
c = c + 1
Next
'Downloads current prices from Kiodex
DownloadCurrentPrices
'Remove invalid pricing columns
If (PricesCleanup) Then
'Setup GAS and OIL worksheets
REFINEDSetup
GasSetup
OilSetup
'Calculate GAS and OIL worksheets
ws_REFINED.Calculate
ws_oil.Calculate
ws_gas.Calculate
'Refresh and display summary worksheet
'ws_summary.Calculate
Calculate
ws_summary.Activate
Refresh
'Set data source value based on NYMEX - Not Updated (0), Preliminary (1), or Updated (2)
c = FIRSTDATA_COL
ds = 0
gaschk = False
oilchk = False
REFINEDchk = False
Do Until (IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, c)) Or (gaschk And oilchk And REFINEDchk))
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "GD Henry Hub", vbTextCompare) And Not gaschk) Then
If (ws_currentprices.Cells(ASOFDATE_ROW, c) = ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
'Data for current date
If (StrComp(ws_currentprices.Cells(DATASOURCE_ROW, c), "Official", vbTextCompare) = 0) Then
'Data is official
ds = ds + 2
Else
'Data is global
ds = ds + 1
End If
Else
'Data for prior date
ds = ds + 0
End If
gaschk = True
End If
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "NYMEX WTI", vbTextCompare) And Not oilchk) Then
If (ws_currentprices.Cells(ASOFDATE_ROW, c) = ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
'Data for current date
If (StrComp(ws_currentprices.Cells(DATASOURCE_ROW, c), "Official", vbTextCompare) = 0) Then
'Data is official
ds = ds + 2
Else
'Data is global
ds = ds + 1
End If
Else
'Data for prior date
ds = ds + 0
End If
oilchk = True
End If
'***REFINED addition***
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "OPIS Ethane Mt Belv non TET", vbTextCompare) And Not REFINEDchk) Then
If (ws_currentprices.Cells(ASOFDATE_ROW, c) = ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
'Data for current date
If (StrComp(ws_currentprices.Cells(DATASOURCE_ROW, c), "Official", vbTextCompare) = 0) Then
'Data is official
ds = ds + 2
Else
'Data is global
ds = ds + 1
End If
Else
'Data for prior date
ds = ds + 0
End If
REFINEDchk = True
End If
c = c + 1
Loop
Select Case ds
Case Is >= 4
ws_summary.Range("SummaryDataSource") = "Updated"
Case Is > 0
ws_summary.Range("SummaryDataSource") = "Preliminary"
Case Else
ws_summary.Range("SummaryDataSource") = "Not Updated"
End Select
Else
ws_summary.Activate
ws_summary.Range("SummaryDataSource") = "Not Updated"
End If
'Set last updated date
ws_summary.Range("LastUpdatedDateTime") = Now
Application.Calculation = xlAutomatic
Application.ReferenceStyle = xlA1
'Update BOKF Pricing History
If Format(asOfDate, "m/d/yyyy") = Format(WorksheetFunction.WorkDay(WorksheetFunction.EoMonth(asOfDate, 0) + 1, -1), "m/d/yyyy") Then
Call UpdateBOKFPriceHistory(Format(DateSerial(Year(asOfDate), Month(asOfDate) + 1, 1), "mm/dd/yyyy"), False)
End If
End Sub
'This function checks the Current Prices tab for any columns that are duplicates of the day before or weekends and deletes the column
Function PricesCleanup() As Boolean
Dim r, c As Integer
Dim removeCount As Integer
Dim removeColumn As Boolean
Dim isGas, isOil, isREFINED As Boolean
c = FIRSTDATA_COL
removeCount = 0
Do Until IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, c)) 'check every col of prices
'Start at the row of the first date and reset remove flag
r = FIRSTDATE_ROW
removeColumn = True
'Check each column, at least until there is a discrepancy between prices so we know it's not a holiday
Do Until ((r > 12 And IsEmpty(ws_currentprices.Cells(r, c))) Or r > 60 Or Not removeColumn)
'If the prices don't match, we know it's not a holiday
If (ws_currentprices.Cells(r, c) <> ws_currentprices.Cells(r, c + 1)) Then
'If the first row is empty or matches second row, it's likely due to near EoM index shifting and requires special handling
If r = FIRSTDATE_ROW Then
If IsEmpty(ws_currentprices.Cells(r, c)) Then
'Oil index swap
removeColumn = False
End If
If (ws_currentprices.Cells(r, c) = ws_currentprices.Cells(r + 1, c) And ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Gas") Then
removeColumn = False
End If
'***Refined
If (ws_currentprices.Cells(r, c) = ws_currentprices.Cells(r + 1, c) And ws_currentprices.Cells(MARKETTYPE_ROW, c) = "REFINED") Then
removeColumn = False
End If
Else
'Not index related and no match, so don't remove column
removeColumn = False
End If
End If
r = r + 1
Loop
'Check for weekend dates or dates from prior month
If Weekday(ws_currentprices.Cells(ASOFDATE_ROW, c)) = 1 Or Weekday(ws_currentprices.Cells(ASOFDATE_ROW, c)) = 7 Or Month(ws_currentprices.Cells(ASOFDATE_ROW, c)) <> Month(ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
removeColumn = True
End If
'Remove column if flagged
If removeColumn Then
removeCount = removeCount + 1
ws_currentprices.Columns(c).EntireColumn.Delete
c = c - 1
End If
'Copy up spot price
If Not IsEmpty(ws_currentprices.Cells(FIRSTDATE_ROW, c)) Then
ws_currentprices.Cells(SPOT_ROW, c) = ws_currentprices.Cells(FIRSTDATE_ROW, c)
ElseIf Not IsEmpty(ws_currentprices.Cells(FIRSTDATE_ROW + 1, c)) Then
ws_currentprices.Cells(SPOT_ROW, c) = ws_currentprices.Cells(FIRSTDATE_ROW + 1, c)
Else
ws_currentprices.Cells(SPOT_ROW, c) = ""
End If
c = c + 1
Loop
'Check if any columns are left and return bool value
isGas = False
isOil = False
isREFINED = False
c = FIRSTDATA_COL
Do Until IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, c))
If (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Gas") Then
isGas = True
ElseIf (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Oil") Then
isOil = True
ElseIf (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Refined") Then
isREFINED = True
End If
c = c + 1
Loop
If (isGas And isOil And isREFINED) Then
PricesCleanup = True
Else
PricesCleanup = False
End If
End Function
Sub GasSetup()
Dim cpr, cpc, r, c, marketcount, marketstartrow As Integer
Dim index As Double
Const YEARMONTH_COL = 1
Const DATE_COL = 2
Const SPOT_COL = 3
Const markettype = "GAS"
ws_gas.UsedRange.ClearContents
cpc = FIRSTDATA_COL
marketcount = 0
'Loop through each column in currentprices looking for gas markets
Do Until (IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, cpc)))
If StrComp(ws_currentprices.Cells(MARKETTYPE_ROW, cpc), markettype, vbTextCompare) = 0 Then
'This is a gas column
cpr = FIRSTDATE_ROW
c = 1
If StrComp(ws_currentprices.Cells(COMMODITY_ROW, cpc), ws_currentprices.Cells(COMMODITY_ROW, cpc - 1), vbTextCompare) <> 0 Then
'Sort prior market data by date
If marketcount <> 0 Then
ws_gas.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_gas.Range("B" & marketstartrow + 1 & ":FF" & r), _
order1:=xlAscending, Header:=xlYes
End If
'Start each new market on row divisible by 30 + 1 to prevent any issues with summary table
marketstartrow = marketcount * 30 + 1
marketcount = marketcount + 1
r = marketstartrow
'Add labels for new market
ws_gas.Cells(r, YEARMONTH_COL) = ws_currentprices.Cells(COMMODITY_ROW, cpc)
ws_gas.Cells(r + 1, YEARMONTH_COL) = "YEARMONTH"
ws_gas.Cells(r + 1, DATE_COL) = "Date"
ws_gas.Cells(r + 1, SPOT_COL) = "Spot"
c = c + 3
For i = 0 To 59
ws_gas.Cells(r + 1, c + i) = i + 1
Next
r = r + 2
End If
'Populate date
ws_gas.Cells(r, DATE_COL) = ws_currentprices.Cells(ASOFDATE_ROW, cpc)
ws_gas.Cells(r, YEARMONTH_COL) = Year(ws_gas.Cells(r, DATE_COL)) & "." & Month(ws_gas.Cells(r, DATE_COL))
'Populate spot
ws_gas.Cells(r, SPOT_COL) = ws_currentprices.Cells(SPOT_ROW, cpc)
c = 4
'Populate row
Do Until cpr > 60 And IsEmpty(ws_currentprices.Cells(cpr, cpc))
ws_gas.Cells(r, c) = ws_currentprices.Cells(cpr, cpc)
cpr = cpr + 1
c = c + 1
Loop
r = r + 1
End If
cpc = cpc + 1
Loop
'Sort final market data by date
ws_gas.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_gas.Range("B" & marketstartrow + 1 & ":B" & r), _
order1:=xlAscending, Header:=xlYes
'Iterate through the Nymex data to update market index values
r = 2
index = 0
Do Until (IsEmpty(ws_gas.Cells(r, DATE_COL)))
If IsEmpty(ws_gas.Cells(r, DATE_COL + 2)) Then
'No value for current month, so take prior row value for index
Call UpdateIndexes(markettype, ws_gas.Cells(r - 1, DATE_COL), ws_gas.Cells(r - 1, DATE_COL + 2))
Exit Do
End If
r = r + 1
Loop
End Sub
Sub OilSetup()
Dim cpr, cpc, r, c, marketcount, marketstartrow As Integer
Dim index As Double
Const YEARMONTH_COL = 1
Const DATE_COL = 2
Const SPOT_COL = 3
Const markettype = "OIL"
ws_oil.UsedRange.ClearContents
cpc = FIRSTDATA_COL
marketcount = 0
marketstartrow = 0
'Loop through each column in currentprices looking for gas markets
Do Until (IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, cpc)))
If StrComp(ws_currentprices.Cells(MARKETTYPE_ROW, cpc), markettype, vbTextCompare) = 0 Then
'This is a gas column
cpr = FIRSTDATE_ROW
c = 1
If StrComp(ws_currentprices.Cells(COMMODITY_ROW, cpc), ws_currentprices.Cells(COMMODITY_ROW, cpc - 1), vbTextCompare) <> 0 Then
'Sort prior market data by date
If marketcount <> 0 Then
ws_oil.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_oil.Range("B" & marketstartrow + 1 & ":FF" & r), _
order1:=xlAscending, Header:=xlYes
End If
'Start each new market on row divisible by 30 + 1 to prevent any issues with summary table
marketstartrow = marketcount * 30 + 1
marketcount = marketcount + 1
r = marketstartrow
'Add labels for new market
ws_oil.Cells(r, YEARMONTH_COL) = ws_currentprices.Cells(COMMODITY_ROW, cpc)
ws_oil.Cells(r + 1, YEARMONTH_COL) = "YEARMONTH"
ws_oil.Cells(r + 1, DATE_COL) = "Date"
ws_oil.Cells(r + 1, SPOT_COL) = "Spot"
c = c + 3
For i = 0 To 59
ws_oil.Cells(r + 1, c + i) = i + 1
Next
r = r + 2
End If
'Populate date
ws_oil.Cells(r, DATE_COL) = ws_currentprices.Cells(ASOFDATE_ROW, cpc)
ws_oil.Cells(r, YEARMONTH_COL) = Year(ws_oil.Cells(r, DATE_COL)) & "." & Month(ws_oil.Cells(r, DATE_COL))
'Populate spot
ws_oil.Cells(r, SPOT_COL) = ws_currentprices.Cells(SPOT_ROW, cpc)
c = 4
'Populate row
Do Until cpr > 60 And IsEmpty(ws_currentprices.Cells(cpr, cpc))
ws_oil.Cells(r, c) = ws_currentprices.Cells(cpr, cpc)
cpr = cpr + 1
c = c + 1
Loop
r = r + 1
End If
cpc = cpc + 1
Loop
'Sort final market data by date
ws_oil.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_oil.Range("B" & marketstartrow + 1 & ":B" & r), _
order1:=xlAscending, Header:=xlYes
'Iterate through the Nymex data to update market index values
r = 2
index = 0
Do Until (IsEmpty(ws_oil.Cells(r, DATE_COL)))
If IsEmpty(ws_oil.Cells(r, DATE_COL + 2)) Then
'No value for current month, so take prior row value for index
Call UpdateIndexes(markettype, ws_oil.Cells(r - 1, DATE_COL), ws_oil.Cells(r - 1, DATE_COL + 2))
Exit Do
End If
r = r + 1
Loop
End Sub
Sub REFINEDSetup()
Dim cpr, cpc, r, c, marketcount, marketstartrow As Integer
Dim index As Double
Const YEARMONTH_COL = 1
Const DATE_COL = 2
Const SPOT_COL = 3
Const markettype = "REFINED"
ws_REFINED.UsedRange.ClearContents
cpc = FIRSTDATA_COL
marketcount = 0
marketstartrow = 0
'Loop through each column in currentprices looking for REFINED markets
Do Until (IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, cpc)))
If StrComp(ws_currentprices.Cells(MARKETTYPE_ROW, cpc), markettype, vbTextCompare) = 0 Then
'This is a REFINED column
cpr = FIRSTDATE_ROW
c = 1
If StrComp(ws_currentprices.Cells(COMMODITY_ROW, cpc), ws_currentprices.Cells(COMMODITY_ROW, cpc - 1), vbTextCompare) <> 0 Then
'Sort prior market data by date
If marketcount <> 0 Then
ws_REFINED.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_REFINED.Range("B" & marketstartrow + 1 & ":FF" & r), _
order1:=xlAscending, Header:=xlYes
End If
'Start each new market on row divisible by 30 + 1 to prevent any issues with summary table
marketstartrow = marketcount * 30 + 1
marketcount = marketcount + 1
r = marketstartrow
'Add labels for new market
ws_REFINED.Cells(r, YEARMONTH_COL) = ws_currentprices.Cells(COMMODITY_ROW, cpc)
ws_REFINED.Cells(r + 1, YEARMONTH_COL) = "YEARMONTH"
ws_REFINED.Cells(r + 1, DATE_COL) = "Date"
ws_REFINED.Cells(r + 1, SPOT_COL) = "Spot"
c = c + 3
For i = 0 To 59
ws_REFINED.Cells(r + 1, c + i) = i + 1
Next
r = r + 2
End If
'Populate date
ws_REFINED.Cells(r, DATE_COL) = ws_currentprices.Cells(ASOFDATE_ROW, cpc)
ws_REFINED.Cells(r, YEARMONTH_COL) = Year(ws_REFINED.Cells(r, DATE_COL)) & "." & Month(ws_REFINED.Cells(r, DATE_COL))
'Populate spot
ws_REFINED.Cells(r, SPOT_COL) = ws_currentprices.Cells(SPOT_ROW, cpc)
c = 4
'Populate row
Do Until cpr > 60 And IsEmpty(ws_currentprices.Cells(cpr, cpc))
ws_REFINED.Cells(r, c) = ws_currentprices.Cells(cpr, cpc)
cpr = cpr + 1
c = c + 1
Loop
r = r + 1
End If
cpc = cpc + 1
Loop
'Sort final market data by date
ws_REFINED.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_REFINED.Range("B" & marketstartrow + 1 & ":B" & r), _
order1:=xlAscending, Header:=xlYes
'Iterate through the Nymex data to update market index values
r = 2
index = 0
Do Until (IsEmpty(ws_REFINED.Cells(r, DATE_COL)))
If IsEmpty(ws_REFINED.Cells(r, DATE_COL + 2)) Then
'No value for current month, so take prior row value for index
Call UpdateIndexes(markettype, ws_REFINED.Cells(r - 1, DATE_COL), ws_REFINED.Cells(r - 1, DATE_COL + 2))
Exit Do
End If
r = r + 1
Loop
End Sub

StrComp in VBA does not return True or False. It returns -1, 0, or 1 depending on the results of the string comparison. If the two strings match for the particular type of comparison chosen then StrComp will return 0.
However, VBA treats 0 as being equivalent to False - see here. This means that if you write a StrComp where the two strings match, but you forget to compare the results to zero, then you will get a result of False if you use the result as if it were a Boolean (e.g. in an If statement).
In your code, you have:
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "GD Henry Hub", vbTextCompare) And Not gaschk) Then
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "NYMEX WTI", vbTextCompare) And Not oilchk) Then
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "OPIS Ethane Mt Belv non TET", vbTextCompare) And Not REFINEDchk) Then
All three statements are incorrectly using the result of StrComp as if it were a Boolean. Change all three to StrComp(...) = 0 instead

Skip Iteration Column

The thing I am trying to do is if vInputs(1, i) is less than 22 I want the code to go to the next iteration column and if it's greater than 22 to just continue with the code.
The problem is in the If vInputs(1, i)... line. Not sure what I am doing wrong:
Sub CreateTestResultTableV2()
Application.ScreenUpdating = False 'helps the code run faster
Dim vInputs, vResults()
Dim c As Integer, i As Integer
'create INPUTS array
c = Range("b5").End(xlToRight).Column
vInputs = Range("b5", Cells(8, c))
'determine last value in the column
c = UBound(vInputs, 2)
'create RESULTS array
ReDim vResults(1 To 3, 1 To c)
For i = 1 To c
If vInputs(1, i) <= 22 Then GoTo Next i
Else
'set values
Range("j16") = vInputs(1, i)
Range("n12") = vInputs(4, i)
'copy output values into RESULTS array
vResults(1, i) = Range("h41")
vResults(2, i) = Range("k41")
vResults(3, i) = Range("z14")
Next i
Range("e47").Resize(3, c) = vResults
Application.ScreenUpdating = True
End Sub

Don't use a Goto statement to skip iterations in a loop. use the opposite operator and only execute the code in the loop when the conditions are True.
For i = 1 To c
If vInputs(1, i) > 22 Then
'set values
Range("j16") = vInputs(1, i)
Range("n12") = vInputs(4, i)
'copy output values into RESULTS array
vResults(1, i) = Range("h41")
vResults(2, i) = Range("k41")
vResults(3, i) = Range("z14")
End if
Next i

modify columns according to condition

Well I have the following problem, I have 2 columns as follows:
A B
"X" 1
"Y" 1
"Z" 0
"W" 2
What I want to do is find a way to create new columns C and D or better still, update columns A and B as follows:
C D
"X" 1
"Y" 1
"Z" 0
"W (1)" 1
"W (2)" 1
Any suggestion or ideas on how can i do this will be much appreciated.

This is not supposed to be a code writing forum. You are expected to show some effort.
Sub split_()
Dim P1 As Range
Range("C1:D99999").Clear
Set P1 = Range("A1").CurrentRegion
a = 1
For i = P1(1).Row To P1.Rows.Count
If P1(i, 2) > 1 Then
For j = 1 To P1(i, 2)
Cells(a, 3) = P1(i, 1) & " (" & j & ")"
Cells(a, 4) = 1
a = a + 1
Next j
Else
Cells(a, 3) = P1(i, 1)
Cells(a, 4) = P1(i, 2)
a = a + 1
End If
Next i
End Sub

VB-Macros to split two strings and insert them as a new row and trim function

I am kind of new to Excel Macros. I have a sample data for which I am trying to write a macro which should perform multiple operations. In the attached excel sheet you could see multiple track# across a single Network#, I want to a put individual track# across there corresponding network#'s and when doing so the space should be trimmed between the N and the number following.
raw data in excel:
X33652 N 4230047169 2013/11/28()
X34704 N4230644769, N4230645169 2014/06/04/m/RB CLRD
X40110 N4230854369, N 4230846569 2014/06/04/B/No Mega
X40605 N 4320617605,N 4320617705,N 4320617805 14/06/12/MayS/CANCELLED/attached email
Ex: Desired output for row 3 is
X40110 N4230854369 2014/06/04/B/No Mega
X40110 N4230846569 2014/06/04/B/No Mega
I am kind of stuck with no help. Any help would be greatly appreciated.
Thanks in Advance.

Here is one of the solutions:
Prerequisites: Sheet1 contains original data (track# in column A, data to split in column B and comment/date in column C), Sheet2 will contain processed data.
Hope that helps.
The code (click Alt+F11, click Insert/Module, paste the code in the inserted module):
Sub test()
Dim a As String, g As String, k As String, l As String
Dim b As Long, c As Long, d As Integer, e As Integer, f As Long, h As Integer, i As Integer, j As Long
b = 1
j = 1
While IsEmpty(Sheet1.Range("A" & b)) = False 'does not check if exceeding excel row limit
b = b + 1
Wend
For c = 1 To b 'Or "2 to b" if data has headers (if first row contains column names)
a = Sheet1.Range("B" & c) 'If column B contains the data to split
k = Sheet1.Range("A" & c) 'network #
l = Sheet1.Range("C" & c) 'date or comment
d = Len(a)
h = 0
For e = 1 To d
If Mid(a, e, 1) = "," Or e = d Then
If h = 0 Then
If e = d Then
i = e
Else
i = e - 1
End If
g = Mid(a, 1, i)
While IsEmpty(Sheet2.Range("B" & j)) = False 'does not check if exceeding excel row limit
j = j + 1
Wend
Sheet2.Range("A" & j) = k
Sheet2.Range("B" & j) = g
Sheet2.Range("C" & j) = l
Else
If e = d Then
g = Mid(a, i + 2, e - i - 1)
Else
g = Mid(a, i + 2, e - i - 2)
End If
While IsEmpty(Sheet2.Range("B" & j)) = False 'does not check if exceeding excel row limit
j = j + 1
Wend
Sheet2.Range("A" & j) = k
Sheet2.Range("B" & j) = g
Sheet2.Range("C" & j) = l
i = e - 1
End If
h = 1
End If
Next e
Next c
Dim m As Long, o As Integer
m = 1 'Or 2 if top row contains headings
Dim n As String
While IsEmpty(Sheet2.Range("B" & m)) = False
Sheet2.Range("B" & m) = Trim(Sheet2.Range("B" & m)) 'trim
n = Sheet2.Range("B" & m)
For o = 1 To Len(n)
If Mid(n, o, 1) = " " Then n = Left(n, 1) & Right(n, Len(n) - 2) 'remove single space
Next o
Sheet2.Range("B" & m) = n
m = m + 1
Wend
End Sub
Try this code (Update according to the comments):
Sub test()
Dim srow As Integer
srow = MsgBox("Does the first row contain data headers (column names)?", vbYesNo + vbQuestion, "First row selection")
If srow = 6 Then
srow = srow - 4
Else
srow = srow - 6
End If
Dim a As String, g As String, k(16383) As String, l(16383) As String
Dim b As Long, c As Long, d As Integer, e As Integer, f As Long, h As Integer, i As Integer, j As Long
b = srow
j = srow
While IsEmpty(Sheet1.Range("A" & b)) = False And b < 1048576
b = b + 1
Wend
b = b - 1
If srow > b Then MsgBox "No entries to analyze!", vbInformation, "Attention!": Exit Sub
Dim spli As String
INPU:
spli = InputBox("Please, enter the Letter of the column, which contains the data to split", "Define split column")
If Len(spli) > 3 Or Len(spli) < 1 Then MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
Dim letc As Integer
For letc = 65 To 122
If letc <> 91 And letc <> 92 And letc <> 93 And letc <> 94 And letc <> 95 And letc <> 96 Then
If Left(spli, 1) = Chr(letc) Then Exit For
If letc = 122 And Left(spli, 1) <> Chr(letc) Then MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
Next letc
If Len(spli) > 1 Then
For letc = 65 To 122
If letc <> 91 And letc <> 92 And letc <> 93 And letc <> 94 And letc <> 95 And letc <> 96 Then
If Mid(spli, 2, 1) = Chr(letc) Then Exit For
If letc = 122 And Mid(spli, 2, 1) <> Chr(letc) Then MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
Next letc
End If
If Len(spli) = 3 Then
For letc = 65 To 122
If letc <> 91 And letc <> 92 And letc <> 93 And letc <> 94 And letc <> 95 And letc <> 96 Then
If Right(spli, 1) = Chr(letc) Then Exit For
If letc = 122 And Right(spli, 1) <> Chr(letc) Then MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
Next letc
If Left(spli, 1) = "Y" Or Left(spli, 1) = "Z" Or Left(spli, 1) = "y" Or Left(spli, 1) = "z" Then
MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
If Left(spli, 1) = "X" Or Left(spli, 1) = "x" Then
If Asc(Mid(spli, 2, 1)) < 65 Or (Asc(Mid(spli, 2, 1)) > 70 And Asc(Mid(spli, 2, 1)) < 97) Or Asc(Mid(spli, 2, 1)) > 102 Then
MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
If Mid(spli, 2, 1) = "F" Or Mid(spli, 2, 1) = "f" Then
If Asc(Right(spli, 1)) < 65 Or (Asc(Right(spli, 1)) > 68 And Asc(Right(spli, 1)) < 97) Or Asc(Right(spli, 1)) > 100 Then
MsgBox "Please, enter a valid Letter of a column", vbCritical + vbOKOnly, "Error!": GoTo INPU
End If
End If
End If
End If
Dim coll As Long, colr As Long, coun As Long
RECL:
coll = InputBox("How many columns to the left of the split data column would you like to copy?", "Left Columns")
If Sheet1.Range(spli & srow).Column - coll < 1 Then
MsgBox "Wrong number of columns indicated", vbExclamation + vbOKOnly, "Error!"
GoTo RECL
End If
RECR:
colr = InputBox("How many columns to the right of the split data column would you like to copy?", "Right Columns")
If Sheet1.Range(spli & srow).Column + colr > 16384 Then
MsgBox "Wrong number of columns indicated", vbExclamation + vbOKOnly, "Error!"
GoTo RECR
End If
For c = srow To b
a = Sheet1.Range(spli & c)
For coun = 0 To coll - 1
k(coun) = Sheet1.Cells(c, Sheet1.Range(spli & c).Column - 1 - coun)
Next coun
For coun = 0 To colr - 1
l(coun) = Sheet1.Cells(c, Sheet1.Range(spli & c).Column + 1 + coun)
Next coun
d = Len(a)
h = 0
For e = 1 To d
If Mid(a, e, 1) = "," Or Mid(a, e, 1) = "/" Or e = d Then
If h = 0 Then
If e = d Then
i = e
Else
i = e - 1
End If
g = Mid(a, 1, i)
While IsEmpty(Sheet2.Range(spli & j)) = False And j < 1048576
j = j + 1
Wend
For coun = 0 To coll - 1
Sheet2.Cells(j, Sheet1.Range(spli & c).Column - 1 - coun) = k(coun)
Next coun
Sheet2.Range(spli & j) = g
For coun = 0 To colr - 1
Sheet2.Cells(j, Sheet1.Range(spli & c).Column + 1 + coun) = l(coun)
Next coun
Else
If e = d Then
g = Mid(a, i + 2, e - i - 1)
Else
g = Mid(a, i + 2, e - i - 2)
End If
While IsEmpty(Sheet2.Range(spli & j)) = False And j < 1048576
j = j + 1
Wend
For coun = 0 To coll - 1
Sheet2.Cells(j, Sheet1.Range(spli & c).Column - 1 - coun) = k(coun)
Next coun
Sheet2.Range(spli & j) = g
For coun = 0 To colr - 1
Sheet2.Cells(j, Sheet1.Range(spli & c).Column + 1 + coun) = l(coun)
Next coun
i = e - 1
End If
h = 1
End If
Next e
Next c
Dim m As Long, o As Integer
m = srow
Dim n As String
While IsEmpty(Sheet2.Range(spli & m)) = False
Sheet2.Range(spli & m) = Trim(Sheet2.Range(spli & m)) 'trim
n = Sheet2.Range(spli & m)
For o = 1 To Len(n)
If Mid(n, o, 1) = " " Then n = Left(n, 1) & Right(n, Len(n) - 2) 'remove single space
Next o
Sheet2.Range(spli & m) = n
m = m + 1
Wend
End Sub

You need to change your code to
Dim i as Long, Temp1 as Str, Temp2() as Str, TempArr() as Str
For i = 1 to 100 ' For e.g. you need 100 rows
Temp1 = Trim(ActiveSheet.Range("A"&i))
TempArr = Split(Temp1," ")
Temp2 = Split(TempArr(1),",")
If Ubound(Temp2) = 1 Then
' i.e. There are 2 values in the second cell,
ActiveSheet.Range("B"&i) = TempArr(0) & " " Temp2(1) & " " & TempArr(2)
Else
' Do nothing
End if
ActiveSheet.Range("B"&i) = TempArr(0) & " " Temp2(0) & " " & TempArr(2)
Next i
This is extremely inefficient but will give an idea how it can be done.

Resources