I'm working with userform to add data in a Table "t_database". For each checkbox = true, add a ROW.
When i add some data, appear "Run-time error '9' Subscript out of range..
To create this code, i used a post founded here and i completed with my requeriments.
Option Explicit
Private Sub cmdAddproject_Click()
Dim chkCnt As Integer
Dim ctl As MSForms.Control, i As Integer, lr As Long
Dim cb As MSForms.CheckBox
With Me
chkCnt = .Tool1.Value + .Tool2.Value + .Tool3.Value + .Tool4.Value + .Tool5.Value + .Tool6.Value + .Tool7.Value + .Tool8.Value + .Tool9.Value + .Tool10.Value + .Tool11.Value + .Tool12.Value + .Tool13.Value + .Tool14.Value + .Tool15.Value + .Tool16.Value + .Tool7.Value + .Tool18.Value + .Tool19.Value + .Tool20.Value + .Tool21.Value + .Tool22.Value + .Tool23.Value + .Tool24.Value + .Tool25.Value + .Tool26.Value + .Tool27.Value + .Tool28.Value + .Tool29.Value + .Tool30.Value
chkCnt = Abs(chkCnt)
If chkCnt <> 0 Then
ReDim mval(1 To chkCnt, 1 To 17)
i = 1
For Each ctl In .Controls
If TypeOf ctl Is MSForms.CheckBox Then
Set cb = ctl
If cb Then
mval(i, 1) = .txtProyecto.Value
mval(i, 2) = .txtAno.Value
mval(i, 3) = .txtEmpresa.Value
mval(i, 4) = .SectorEmpresa.Value
mval(i, 5) = .TipoEmpresa.Value
mval(i, 6) = .txtDireccion.Value
mval(i, 7) = .txtCiudad.Value
mval(i, 8) = .txtCodigoPostal.Value
mval(i, 9) = .txtPais.Value
mval(i, 10) = .txtDescripcion.Value
mval(i, 11) = .txtIndicador1.Value
mval(i, 12) = .metrica1.Value
mval(i, 13) = .txtIndicador2.Value
mval(i, 14) = .metrica2.Value
mval(i, 15) = cb.Caption
mval(i, 16) = .txtAhorrosPrevistos.Value
mval(i, 17) = .txtAhorrosObtenidos.Value
i = i + 1
End If
End If
Next
End If
End With
With Sheets("Database")
lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & lr).Resize(UBound(mval, 1), 17) = mval
End With
End Sub
Related
I got problem with calendar in VBA. Wants to create a calendar that will show/paint the range of week numbers from 2022 depending on the date entered in columns A22 and B22. The problem occurs when the week numbers repeat between months.
Tydzien = Week
Sty = January
Lut = February
Option Explicit
Sub Kolorowaniedaty()
Dim rok As Integer
rok = Left(Cells(22, 2), 4)
Dim miesiacpocz As Integer
miesiacpocz = Mid(Cells(22, 2), 7, 1)
Dim miesiackon As Integer
miesiackon = Mid(Cells(22, 3), 7, 1)
Dim Datapocz As Integer
Datapocz = Application.WorksheetFunction.WeekNum(Cells(22, 2), 2)
Dim Datakon As Integer
Datakon = Application.WorksheetFunction.WeekNum(Cells(22, 3), 2)
Dim Rokzdaty As String
Rokzdaty = CStr(Mid(Cells(22, 2), 3, 2))
Dim Rok2022 As Byte
Rok2022 = 22
Dim kolumna As Byte
For kolumna = 1 To 20
If Rokzdaty = Rok2022 And miesiacpocz = miesiackon Then
Range(Cells(22, Datapocz + 4), Cells(22, Datakon + 4)).Interior.Color = vbYellow
Else: Range(Cells(22, Datapocz + 4), Cells(22, Datakon + 5)).Interior.Color = vbYellow
End If
Next kolumna
End Sub
I cant upload image of Makro and Calendar from excel cuz i dont have enought points of reputations. If someone can help from private chat i will be really really thankful. Its must have from to my work.
[![enter image description here][3]][3]
Its Its suppose to mark 11 weeks but its show only 10 weeks. Any advice?
[3]: https://i.stack.imgur.com/X8kwQ.png
Iterate over each day in the date range and increment the column number each monday or change of month. Store the column numbers in an array and use it as a lookup to determine the column number for a given date. Run this is a new clean workbook.
update - complete rewrite
Option Explicit
Const START_COL = 4
Const START_ROW = 22
Const MAX_YEARS = 4
Const START_YEAR = 2022
Sub CalendarDemo()
Dim ws As Worksheet
Dim dt As Date, dtDay1 As Date
Dim wkno As Long, dayno As Long
Dim colno As Long, i As Long, c As Long, r As Long
Dim arCol, arDate
ReDim arCol(1 To 2, 1 To MAX_YEARS * 12 * 7)
ReDim arDate(1 To MAX_YEARS * 366, 1 To 5) ' wkno, month no, column, date, dow
' start Jan 1
dtDay1 = DateSerial(START_YEAR, 1, 1)
colno = 1
wkno = 1
i = 1
' iterate through days built look up array
dt = dtDay1
Do While Year(dt) < START_YEAR + MAX_YEARS
arDate(i, 2) = Month(dt)
arDate(i, 5) = Weekday(dt, vbMonday)
If i > 1 Then
' change of week or month
If arDate(i, 5) = 1 Then
wkno = wkno + 1
If (wkno > 52) And (Month(dt) = 1) Then wkno = 1
colno = colno + 1
ElseIf arDate(i, 2) <> arDate(i - 1, 2) Then
colno = colno + 1
End If
End If
' reset wkno to 1 on jan 1st
If wkno >= 52 And arDate(i, 2) = 1 Then wkno = 1
arDate(i, 1) = wkno
arDate(i, 3) = colno
arDate(i, 4) = dt
' fill arCol
arCol(1, colno) = Format(dt, "mmm yyyy")
arCol(2, colno) = wkno
dt = dt + 1
i = i + 1
Loop
' paint cells
Dim lastrow As Long, dtStart As Date, dtEnd As Date
Dim colStart As Long, colEnd As Long, n As Long, m As Long
Set ws = Sheets(1)
Call testdata(ws)
With ws
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For r = START_ROW To lastrow
' check dates are valid
dtStart = .Cells(r, "B")
dtEnd = .Cells(r, "C")
If dtEnd < dtStart Then
MsgBox "End Date before Start Date on row " & r, vbCritical
Exit Sub
ElseIf dtStart < dtDay1 Then
MsgBox "Start Date before 1 Jan " & START_YEAR & " on row " & r, vbCritical
Exit Sub
End If
' calc day number relative to day1
m = DateDiff("d", dtDay1, dtStart, dtDay1) + 1
n = DateDiff("d", dtDay1, dtEnd, dtDay1) + 1
If n > UBound(arDate) Or m > UBound(arDate) Then
MsgBox "Increase MAX_YEARS for row " & r, vbCritical
Exit Sub
End If
' lookup col number
colStart = arDate(m, 3) + START_COL
colEnd = arDate(n, 3) + START_COL
' merge and color
With .Cells(r, colStart)
With .Resize(1, colEnd - colStart + 1)
.Interior.Color = vbYellow
.Borders.LineStyle = xlContinuous
.Merge
End With
.Value = Space(5) & Format(dtStart, "dd mmm") & " - " & Format(dtEnd, "dd mmm yyyy")
End With
Next
End With
' add headers
Call FormatSheet(ws, arCol, arDate, colno)
MsgBox "Generated " & colno & " Columns", vbInformation
End Sub
Sub FormatSheet(ws As Worksheet, arCol, arDate, colno As Long)
Dim c As Long, i As Long, n As Long, dt As Date
' format sheet header rows
With Sheet1
.Rows("10:21").Clear
.Cells.MergeCells = False
With .Range("E20").Resize(2, colno)
.NumberFormat = "#"
.HorizontalAlignment = xlCenter
.Value2 = arCol
End With
' merge months
i = 0
For c = 5 To colno + 4
If .Cells(20, c + 1) = .Cells(20, c) Then
i = i + 1
Else
With .Cells(20, c - i)
Application.DisplayAlerts = False
.Resize(1, i + 1).Merge
Application.DisplayAlerts = True
.Resize(2, 1).Borders(xlLeft).LineStyle = xlContinuous
End With
i = 0
End If
Next
End With
' calendar to check array
For i = 1 To UBound(arDate)
dt = arDate(i, 4) ' date
n = arDate(i, 5) ' weekday
If dt > 0 Then
n = Weekday(dt, vbMonday)
ws.Cells(10 + n, arDate(i, 3) + START_COL) = Day(dt)
End If
' mon,tue,wed
If i < 8 Then
ws.Cells(10 + n, START_COL) = WeekdayName(n)
End If
Next
End Sub
Sub testdata(ws)
With ws
.Cells(22, 2) = "2022-01-01": .Cells(22, 3) = "2022-03-08"
.Cells(23, 2) = "2022-02-01": .Cells(23, 3) = "2022-02-28"
.Cells(24, 2) = "2022-03-01": .Cells(24, 3) = "2022-03-31"
.Cells(25, 2) = "2022-03-15": .Cells(25, 3) = "2022-05-15"
.Cells(26, 2) = "2022-03-15": .Cells(26, 3) = "2024-03-20"
End With
End Sub
Getting a subscript out of range error for this code. I'm fairly new to VBA so it may be something very obvious but I can't get it to work:
Sub Actual()
Dim rw As Integer
Dim i As Integer
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wb2 As Workbook
Dim TAmt, VAmt, UAmt, OAmt As Double
Worksheets("Act").Range("G1").Activate
Let rw = ActiveCell
Workbooks.Open Filename:=ThisWorkbook.Path & "\2. 2019 Legacy"
Set wb2 = ThisWorkbook
For i = 0 To 2
wb2.Worksheets("VBA Input").Activate
VAmt = Cells(3 + (i * 5), 9)
UAmt = Cells(4 + (i * 5), 9) + Cells(5 + (i * 5), 9)
TAmt = Cells(6 + (i * 5), 9)
OAmt = Cells(7 + (i * 5), 9)
wb.Worksheets("Act").Activate
Cells(rw + i, 16) = TAmt
Cells(rw + i, 17) = VAmt
Cells(rw + i, 18) = UAmt
Cells(rw + i, 19) = OAmt
Next
End Sub
Debugging highlights the line just after the for loop and gives a subscript out of range error.
I currently have a macro that will apply conditional formatting to a cell (in this it is cell "G" but I think it would be better if I was able to have the macro apply the conditional formatting to whatever cell I have selected so that I am not limited to only the cell I have setup in the macro.
Sub ColorCoringPluskey()
'
' ColorCoringPluskey Macro
'
Dim wb As Workbook
Dim wsKey As Worksheet
Dim wsFees As Worksheet
Dim aKeyColors(1 To 20, 1 To 2) As Variant
Dim aOutput() As Variant
Dim sKeyShName As String
Dim i As Long, j As Long
Set wb = ActiveWorkbook
Set wsFees = wb.Sheets("Fees")
sKeyShName = "Color Coding Key"
On Error Resume Next
Set wsKey = wb.Sheets(sKeyShName)
On Error GoTo 0
If wsKey Is Nothing Then
Set wsKey = wb.Sheets.Add(After:=ActiveSheet)
wsKey.Name = sKeyShName
With wsKey.Range("A1:B1")
.Value = Array("Word", "Color")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
Else
wsKey.Range("A2:B" & wsKey.Rows.Count).Clear
End If
aKeyColors(1, 1) = "Strategize": aKeyColors(1, 2) = 10053120
aKeyColors(2, 1) = "Coordinate": aKeyColors(2, 2) = 13421619
aKeyColors(3, 1) = "Committee": aKeyColors(3, 2) = 16777062
aKeyColors(4, 1) = "Attention": aKeyColors(4, 2) = 2162853
aKeyColors(5, 1) = "Work": aKeyColors(5, 2) = 5263615
aKeyColors(6, 1) = "Circulate": aKeyColors(6, 2) = 10066431
aKeyColors(7, 1) = "Numerous": aKeyColors(7, 2) = 13158
aKeyColors(8, 1) = "Follow up": aKeyColors(8, 2) = 39372
aKeyColors(9, 1) = "Attend": aKeyColors(9, 2) = 65535
aKeyColors(10, 1) = "Attention to": aKeyColors(10, 2) = 65535
aKeyColors(11, 1) = "Print": aKeyColors(11, 2) = 10092543
aKeyColors(12, 1) = "WIP": aKeyColors(12, 2) = 13056
aKeyColors(13, 1) = "Prepare": aKeyColors(13, 2) = 32768
aKeyColors(14, 1) = "Develop": aKeyColors(14, 2) = 3394611
aKeyColors(15, 1) = "Participate": aKeyColors(15, 2) = 10092441
aKeyColors(16, 1) = "Organize": aKeyColors(16, 2) = 13369548
aKeyColors(17, 1) = "Various": aKeyColors(17, 2) = 16751103
aKeyColors(18, 1) = "Maintain": aKeyColors(18, 2) = 16724787
aKeyColors(19, 1) = "Team": aKeyColors(19, 2) = 16750950
aKeyColors(20, 1) = "Address": aKeyColors(20, 2) = 6697881
wsFees.Cells.FormatConditions.Delete
ReDim aOutput(1 To UBound(aKeyColors, 1), 1 To 2)
With wsFees.Columns("G")
For i = LBound(aKeyColors, 1) To UBound(aKeyColors, 1)
If WorksheetFunction.CountIf(.Cells, "*" & aKeyColors(i, 1) & "*") > 0 Then
j = j + 1
aOutput(j, 1) = aKeyColors(i, 1)
aOutput(j, 2) = aKeyColors(i, 2)
.FormatConditions.Add xlTextString, String:=aKeyColors(i, 1), TextOperator:=xlContains
.FormatConditions(.FormatConditions.Count).Interior.Color = aKeyColors(i, 2)
End If
Next i
End With
If j > 0 Then
wsKey.Range("A2").Resize(j, 1).Value = aOutput
For i = 1 To j
wsKey.Cells(i + 1, "B").Interior.Color = aOutput(i, 2)
Next i
wsKey.Columns("A").EntireColumn.AutoFit
End If
End Sub
Thanks for any help!
This is the updated code. I am getting a mismatch error now. It would be great if someone could offer some help. Thanks in advance!
Sub Macro2()
Dim rowcount As Long
Dim target As Variant, startcell4 As Range
Set startcell4 = ActiveSheet.Cells(2, 1)
rowcount = Range(Range("E2"), Range("E2").End(xlDown)).Rows.Count
For i = 2 To rowcount + 1
If Not ActiveSheet.Cells(i, 26) = ActiveSheet.Cells(i + 1, 26) Then
Set target = Application.Match(ActiveSheet.Cells(i, 26), Worksheets(19).Range("A6:A3000"), 0)
If Not IsError(target) Then
ActiveSheet.startcell4.Offset(0, 17).Value = Worksheets(19).Cells(target + 6, 10)
Set startcell4 = ActiveSheet.Cells(i + 1, 26)
End If
End If
Next i
End Sub
Changed:
"Set target = ..." to "target = ..."
"ActiveSheet.startcell4" to "startcell4"
A little refactoring
Coming to this
Sub Macro2()
Dim rowcount As Long
Dim target As Variant, startcell4 As Range
Set startcell4 = Cells(2, 1)
rowcount = Range("E2").End(xlDown).Row
For i = 2 To rowcount
If Not Cells(i, 26) = Cells(i + 1, 26) Then
target = Application.Match(Cells(i, 26), Worksheets(19).Range("A6:A3000"), 0)
If Not IsError(target) Then
startcell4.Offset(0, 17).Value = Worksheets(19).Cells(target + 6, 10)
Set startcell4 = Cells(i + 1, 26)
End If
End If
Next i
End Sub
I've been trying to run the following code without luck. Nothing happens:
dim Dim OutputDataBordyRange As Range
Dim OutputCell As Range
For Each OutputCell In OutputDataBordyRange.Cells
If OutputCell Is Nothing Then
OutputCell.Value = 0
End If
Next OutputCell
Any suggestions?
Edit. I've tried below suggestions without luck. therefore, as requested, find below full code:
Sub Output_SBTB()
Dim InputDataRange As Range
Dim InputCountryRange As Range
Dim InputSiteRange As Range
Dim InputServiceLineRange As Range
Dim InputCalcHourlySalaryRateRange As Range
Dim InputRegionRange As Range
Dim OutputDataBodyRange As Range
Dim OutputHearderRowRange As Range
Dim OutputArrayColumns As Long
Dim OutputArrayRows As Long
Dim OutputArray() As Variant
Dim OutputArrayCounter As Long
Dim InputRowCounter As Long
Dim MatchRegion As Long
Dim InputCurrentSiteRowsCount As Long
Dim i As Long
Dim OutputCell As Range
Set InputDataRange = ThisWorkbook.Worksheets(Sheet3.Name).PivotTables("PivotTableData").DataBodyRange
Set InputCountryRange = ThisWorkbook.Worksheets(Sheet3.Name).PivotTables("PivotTableData").PivotFields("Country").DataRange
Set InputSiteRange = ThisWorkbook.Worksheets(Sheet3.Name).PivotTables("PivotTableData").PivotFields("Site").DataRange
Set InputServiceLineRange = ThisWorkbook.Worksheets(Sheet3.Name).PivotTables("PivotTableData").PivotFields("Serviceline").DataRange
Set InputCalcHourlySalaryRateRange = ThisWorkbook.Worksheets(Sheet3.Name).PivotTables("PivotTableData").PivotFields("CalcHourlySalaryRate").DataRange
Set InputRegionRange = ThisWorkbook.Worksheets(Sheet4.Name).PivotTables("PivotTableRegion").PivotFields("Country").DataRange
Set OutputDataBodyRange = ThisWorkbook.Worksheets(Sheet2.Name).ListObjects("TableOutput").DataBodyRange
Set OutputHearderRowRange = ThisWorkbook.Worksheets(Sheet2.Name).ListObjects("TableOutput").HeaderRowRange
OutputArrayColumns = InputDataRange.Rows.Count
OutputArrayRows = OutputHearderRowRange.Columns.Count
ReDim Preserve OutputArray(OutputArrayRows, 1)
OutputArrayCounter = 0
If Not OutputDataBodyRange Is Nothing Then
OutputDataBodyRange.Delete
End If
For InputRowCounter = 1 To InputDataRange.Rows.Count
If InputSiteRange(InputRowCounter) <> InputSiteRange(InputRowCounter - 1) Then
OutputArrayCounter = OutputArrayCounter + 1
ReDim Preserve OutputArray(OutputArrayRows, OutputArrayCounter)
MatchRegion = Application.WorksheetFunction.Match(InputCountryRange(InputRowCounter), InputRegionRange, 0)
OutputArray(1, OutputArrayCounter) = InputRegionRange(MatchRegion).Offset(0, -1)
OutputArray(2, OutputArrayCounter) = InputCountryRange(InputRowCounter)
OutputArray(3, OutputArrayCounter) = InputSiteRange(InputRowCounter)
InputCurrentSiteRowsCount = Application.WorksheetFunction.CountIf(InputSiteRange, OutputArray(3, OutputArrayCounter)) - 1
For i = 0 To InputCurrentSiteRowsCount
' *** Landscaping & Irrigation System ***
If InputServiceLineRange(InputRowCounter + i) = "3.2.3-3.2.4 Landscaping & Irrigation System" Or InputServiceLineRange(InputRowCounter + i) = "Landscaping & Irrigation System - SBTB" Then
If InputCalcHourlySalaryRateRange(InputRowCounter + i) = "(blank)" Then
OutputArray(4, OutputArrayCounter) = OutputArray(4, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 1)
OutputArray(5, OutputArrayCounter) = OutputArray(5, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 2)
OutputArray(6, OutputArrayCounter) = OutputArray(6, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 3)
Else
OutputArray(4, OutputArrayCounter) = OutputArray(4, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 1) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 4)
OutputArray(5, OutputArrayCounter) = OutputArray(4, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 2) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 5)
OutputArray(6, OutputArrayCounter) = OutputArray(4, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 3) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 6)
End If
End If
' *** Interior Plant and Tree Maintenance ***
If InputServiceLineRange(InputRowCounter + i) = "3.2.11 Interior Plant and Tree Maintenance" Or InputServiceLineRange(InputRowCounter + i) = "Interior Plant and Tree Maintenance - SBTB" Then
If InputCalcHourlySalaryRateRange(InputRowCounter + i) = "(blank)" Then
OutputArray(7, OutputArrayCounter) = OutputArray(7, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 1)
OutputArray(8, OutputArrayCounter) = OutputArray(8, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 2)
OutputArray(9, OutputArrayCounter) = OutputArray(9, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 3)
Else
OutputArray(7, OutputArrayCounter) = OutputArray(7, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 1) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 4)
OutputArray(8, OutputArrayCounter) = OutputArray(8, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 2) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 5)
OutputArray(9, OutputArrayCounter) = OutputArray(9, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 3) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 6)
End If
End If
' *** Interior Pest Control ***
If InputServiceLineRange(InputRowCounter + i) = "3.3.10 Interior Pest Control" Or InputServiceLineRange(InputRowCounter + i) = "Pest Control - SBTB" Then
If InputCalcHourlySalaryRateRange(InputRowCounter + i) = "(blank)" Then
OutputArray(10, OutputArrayCounter) = OutputArray(10, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 1)
OutputArray(11, OutputArrayCounter) = OutputArray(11, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 2)
OutputArray(12, OutputArrayCounter) = OutputArray(12, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 3)
Else
OutputArray(10, OutputArrayCounter) = OutputArray(10, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 1) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 4)
OutputArray(11, OutputArrayCounter) = OutputArray(11, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 2) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 5)
OutputArray(12, OutputArrayCounter) = OutputArray(12, OutputArrayCounter) + InputDataRange(InputRowCounter + i, 3) + InputCalcHourlySalaryRateRange(InputRowCounter + i) * InputDataRange(InputRowCounter + i, 6)
End If
End If
Next i
End If
Next InputRowCounter
ThisWorkbook.Worksheets(Sheet2.Name).Range("A3:L" & OutputArrayCounter) = Application.WorksheetFunction.Transpose(OutputArray)
For Each OutputCell In OutputDataBodyRange.Cells
If OutputCell.Value = vbNullString Then
OutputCell.Value = 0
End If
Next OutputCell
End Sub
If anything needs to be specified, please let me know.
If the cells are actually empty, you could skip the loop and just use:
On Error Resume Next
OutputDataBordyRange.SpecialCells(xlcelltypeblanks).Value2 = 0
On Error Goto 0
The Nothing keyword is not used to see if a cell is empty, it is used to see if a variable holds the default value for it's declared data type, or assign the default value to it (see this for more information).
Try the following:
For Each OutputCell In OutputDataBordyRange.Cells
If OutputCell.Value = vbNullString Then
OutputCell.Value = 0
End If
Next OutputCell