lastColumn_Of_PO_line_Big_Table = Sheets("PO_line_Big_Table").UsedRange.Columns.Count + 1
a = Dict_Metadata.Keys
For Each b In a
For i = 1 To UBound(Arr_PO_line_Big_Table)
If Arr_PO_line_Big_Table(i, 1) = b Then
With Worksheets("PO_line_Big_Table")
nextRow = Sheets("Final_Result").Cells(Sheets("Final_Result").Rows.Count, 1).End(xlUp).row + 1
'.Cells(nextRow, "A") = strKey
'.Cells(i + 1, lastColumn_Of_PO_line_Big_Table) = "YES"
Union(.Cells(i + 1, "E"), .Cells(i + 1, "K"), .Cells(i + 1, "L"), .Cells(i + 1, "M")).Copy
Sheets("Final_Result").Range("B" & nextRow).PasteSpecial
End With
End If
Next
Next
Could someone please tell me why it doesn't paste the value in sheet "PO_line_Big_Table" to sheet Final_Result, thank you in advanced!!
Related
I'm new to InkPicture but I like to use it for user to put signature into the form.
I can't seem to save the signature (inkpicture) to the spreadsheet it just inputs it as 0 into the cell I specify.
With UserForm1.InkPicture1.InkEnabled = False Set.Ink
Me.InkPicture1.Ink
.InkEnabled = True End With
lrDep = Sheets("Deploy").Range("A" & Rows.Count).End(xlUp).Row Sheets("Deploy").Cells(lrDep + 1, "A").Value = TBox1.Text Sheets("Deploy").Cells(lrDep + 1, "B").Value = TBox2.Text Sheets("Deploy").Cells(lrDep + 1, "C").Value = TBox3.Text Sheets("Deploy").Cells(lrDep + 1, "D").Value = TBox4.Text
Sheets("Deploy").Cells(lrDep + 1, "G").Value = InkPicture1.Ink
Could someone please help me.
Thank you.
This is not a complete answer but will help you on your way, comment if you have any questions.
First you will have to have a text box on your form that requires the asset ID,
this will have to be amended to match your current form.
Dim RowN As Long
Dim SearchTxt
SearchTxt = TextBox1.Value 'This should be set to the text box name on the form of the asset ID
On Error Resume Next
RowN = Application.WorksheetFunction.Match(SearchTxt, Range("A:A"), 0)
On Error GoTo 0
If RowN > 0 Then
'your code here if matches
MsgBox RowN ' display the row number
Else
'your code here if no match, possibly add new row of data
MsgBox "No match found"
End If
Now you can amend each line of code to use the found row number, for example:
Sheets("Data").Cells("A" & RowN).Value = TextBox1.Txt
If I was creating this form, I would add a search button to check the asset ID and where it finds a match, all the text boxes would then be populated with the current values of the data, these can then be amended before adding back to the sheet.
The following will look for the ID in Column A and if found will use that row to enter the data, this assumes that the ID is stored in TextBox1.Text, amend as required:
Private Sub SB1_Click()
Dim lrREG As Long, lrB As Long, lrDep As Long, lrDis As Long, lrDAT As Long
Dim foundID As Range
Set foundID = Sheets("Data").Range("A:A").Find(What:=TextBox1.Text, Lookat:=xlWhole)
If Not foundID Is Nothing Then
Sheets("Data").Cells(foundID.Row, "A").Value = TextBox1.Text
Sheets("Data").Cells(foundID.Row, "B").Value = TextBox2.Text
Sheets("Data").Cells(foundID.Row, "C").Value = TextBox3.Text
Else
lrDAT = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Data").Cells(lrDAT, "A").Value = TextBox1.Text
Sheets("Data").Cells(lrDAT, "B").Value = TextBox2.Text
Sheets("Data").Cells(lrDAT, "C").Value = TextBox3.Text
End If
lrREG = Sheets("Register").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Register").Cells(lrREG + 1, "A").Value = TextBox1.Text
Sheets("Register").Cells(lrREG + 1, "B").Value = TextBox2.Text
Sheets("Register").Cells(lrREG + 1, "C").Value = TextBox3.Text
lrB = Sheets("Built").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Built").Cells(lrB + 1, "A").Value = TB1.Text
Sheets("Built").Cells(lrB + 1, "B").Value = TB2.Text
Sheets("Built").Cells(lrB + 1, "C").Value = TB3.Text
Sheets("Built").Cells(lrB + 1, "D").Value = TB4.Text
Sheets("Built").Cells(lrB + 1, "E").Value = TB5.Text
Sheets("Built").Cells(lrB + 1, "F").Value = TB6.Text
lrDep = Sheets("Deploy").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Deploy").Cells(lrDep + 1, "A").Value = TBox1.Text
Sheets("Deploy").Cells(lrDep + 1, "B").Value = TBox2.Text
Sheets("Deploy").Cells(lrDep + 1, "C").Value = TBox3.Text
Sheets("Deploy").Cells(lrDep + 1, "D").Value = TBox4.Text
Sheets("Deploy").Cells(lrDep + 1, "E").Value = TBox5.Text
Sheets("Deploy").Cells(lrDep + 1, "F").Value = TBox6.Text
lrDis = Sheets("Dispose").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Dispose").Cells(lrB + 1, "A").Value = TextBo1.Text
Sheets("Dispose").Cells(lrDis + 1, "B").Value = TextBo2.Text
Sheets("Dispose").Cells(lrDis + 1, "C").Value = TextBo3.Text
Sheets("Dispose").Cells(lrDis + 1, "D").Value = TextBo4.Text
Sheets("Dispose").Cells(lrDis + 1, "E").Value = TextBo5.Text
Sheets("Dispose").Cells(lrDis + 1, "F").Value = TextBo6.Text
End Sub
I am organizing a dirty text in an organised table. And this code stops when the cell the marked line is completed. Can you help me to make it continuing the loop?
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim sh7 As Worksheet
Dim CNAME As String
Set sh = Worksheets("Sheet6")
Set sh7 = Worksheets("Sheet7")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For n = 1 To lr
If InStr(1, sh.Cells(n, 1), "CALL:") = 1 Then
CNAME = sh.Cells(n, 7).Value
Ci = sh.Cells(n + 1, 7).Value
Cpd = sh.Cells(n + 1, 7).Value
Else
If InStr(1, sh.Cells(n, 1), "Topic:") = 1 Then
T = sh.Cells(n, 2)
Tpd = sh.Cells(n + 1, 2)
Types = sh.Cells(n + 4, 2)
DM = sh.Cells(n + 5, 2)
D = sh.Cells(n + 5, 4)
OD = sh.Cells(n + 6, 2)
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
sh7.Cells(lr7 + 1, 1).Value = CNAME '********This is the last line it runs.
sh7.Cells(lr7 + 1, 2).Value = Ci
sh7.Cells(lr7 + 1, 3).Value = Cpd
sh7.Cells(lr7 + 1, 4).Value = T
sh7.Cells(lr7 + 1, 5).Value = Tpd
sh7.Cells(lr7 + 1, 6).Value = Types
sh7.Cells(lr7 + 1, 7).Value = DM
sh7.Cells(lr7 + 1, 8).Value = D
sh7.Cells(lr7 + 1, 9).Value = OD
End If
End If
Next n
End Sub
You should get in the habit of defining all variables and supplying a default value.
EDIT:
It seems my original conclusion was incorrect. Upon further inspection I see what might be an issue in your code. Both times where you are trying to get the last row, you are using Rows.Count as a parameter.
Maybe change these
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
To this (note that I use the sheet variable in the first param)
lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(sh7.Rows.Count, 1).End(xlUp).Row
I've got a code that keeps on returning a run-time error 1004 - Application-defined or object-defined error. I've tried stepping through the individual parts of the worksheetfunction.countif function, and they all work fine separately.
However, when I put them together, they fail.
The code is:
s = 2
While Cells(s - 1, 1) <> vbNullString
Rows(s & ":" & s + 3).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cells(s, 1), Cells(s + 3, 1)).Select
Selection.Rows.Group
Cells(s, 1) = "A"
Cells(s + 1, 1) = "B"
Cells(s + 2, 1) = "C"
Cells(s + 3, 1) = "D"
r = 3
q = vbNullString
p = vbNullString
n = s
While n < s + 5
While r <= v
M = 1
If Cells(n, 1) = "A" Then
q = 5
p = 12
ElseIf Cells(n, 1) = "B" Then
q = 18
p = 25
ElseIf Cells(n, 1) = "C" Then
q = 31
p = 38
ElseIf Cells(n, 1) = "D" Then
q = 44
p = 51
End If
While M <= u
l = vbNullString
l = WorksheetFunction.CountIf(Worksheets("IT Teams").Range(Cells(q, M), Cells(p, M)), Worksheets("Players IT").Cells(s + 4, 1))
If Not IsError(l) Then
Cells(n, r) = l
Else
Cells(n, r) = vbNullString
End If
M = M + 5
r = r + 1
Wend
Wend
n = n + 1
r = 3
Wend
s = s + 5
Wend
All variables have been declared as Variants.
Edit: for clarity. Error occurs at:
l = WorksheetFunction.CountIf(Worksheets("IT Teams").Range(Cells(q, M), Cells(p, M)), Worksheets("Players IT").Cells(s + 4, 1))
The problem is the way you declare the ranges. You should always include the sheet, otherwise you get this error, if you use more than one sheet (or if you use one, but it is not the active one).
Like this:
With ActiveSheet
While Cells(s - 1, 1) <> vbNullString
.Rows(s & ":" & s + 3).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range(.Cells(s, 1), .Cells(s + 3, 1)).Select
Selection.Rows.Group
.Cells(s, 1) = "A"
.Cells(s + 1, 1) = "B"
.Cells(s + 2, 1) = "C"
.Cells(s + 3, 1) = "D"
Wend
End With
Pay attention to the dots.
In general, declare the sheets and then use them:
'Option Explicit - start using option explicit
Sub test()
Dim wksA As Worksheet
Dim wksIT As Worksheet
Set wksA = ThisWorkbook.ActiveSheet
Set wksIT = ThisWorkbook.Worksheets("IT Teams")
s = 2
While Cells(s - 1, 1) <> vbNullString
wksA.Rows(s & ":" & s + 3).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wksA.Range(wksA.Cells(s, 1), wksA.Cells(s + 3, 1)).Select
Selection.Rows.Group
wksA.Cells(s, 1) = "A"
wksA.Cells(s + 1, 1) = "B"
wksA.Cells(s + 2, 1) = "C"
wksA.Cells(s + 3, 1) = "D"
Wend
With wksIT
While M <= u
l = vbNullString
l = WorksheetFunction.CountIf(.Range(.Cells(q, M), _
.Cells(p, M)), .Cells(s + 4, 1))
If Not IsError(l) Then
.Cells(n, r) = l
Else
.Cells(n, r) = vbNullString
End If
M = M + 5
r = r + 1
Wend
End With
End Sub
Concerning your case, I am about 80% sure, that you get the error somewhere here:
l = WorksheetFunction.CountIf(Range(Cells(q, M), Cells(p, M)), Cells(s + 4, 1))
In general, never assume which worksheet your code is operating on and explicitly define it in your code.
Concerning the place where you get the error, it should be simply like this:
Set wksA = ThisWorkbook.ActiveSheet
Set wksIT = ThisWorkbook.Worksheets("IT Teams")
Set wksPl = ThisWorkbook.Worksheets("SomePlayers")
l = WorksheetFunction.CountIf(wksIT.Range(wksIT.Cells(q, M), wksIT.Cells(p, M)), _
wksPl.Cells(s + 4, 1))
I have to insert missing dates to a row without deleting the duplicated dates (for a billing program). Example data:
DATE
01/02/2016
02/02/2016
03/02/2016
03/02/2016
03/02/2016
06/02/2016
07/02/2016
08/02/2016
My code is infinitely looping and deleting the duplicate dates. Why does this happen?
Sub InsertMissingDates()
Dim i As Long
Dim RowCount As Long
i = 4
Do
If Cells(i, 1) + 1 <> Cells(i + 1, 1) Then
Rows(i + 1).Insert
Cells(i + 1, 1) = Cells(i, 1) + 1
End If
i = i + 1
Loop Until Cells(i + 1, 1) = "31.10.2016"
End Sub
Here is the code modified with comments to address your issues
Sub InsertMissingDates()
Dim i As Long
Dim RowCount As Long
i = 4
Do
'Use less then instead of <> so it doesn't flag duplicate cells
If Cells(i, 1) + 1 < Cells(i + 1, 1) Then
Rows(i + 1).Insert
Cells(i + 1, 1) = Cells(i, 1) + 1
End If
'Second check to add value if the next row is blank
If (Cells(i + 1, 1) = "") Then
Cells(i + 1, 1) = Cells(i, 1) + 1
End If
i = i + 1
'Changed the loop function from cells(i+1,1) to cells(i,1) since you already
'incremented i
'Also made the date check slightly more robust with dateserial
Loop Until Cells(i, 1).Value >= DateSerial(2016, 1, 30)
End Sub
I need to reduce the code where am I writing the synatx manytimes for copying and pasting the row values.
Private Sub btn_upload_Click()
'Frm_Mainform.Show
'MsgBox ("Process Complete - Please Check File in Output Folder")
Const FOLDER As String = "C:\SBI_Files\"
On Error GoTo ErrorHandler
Dim i As Integer
i = 18
Dim fileName As String
fileName = Dir(FOLDER, vbDirectory)
Do While Len(fileName) > 0
If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then
i = i + 1
Dim currentWkbk As Excel.Workbook
Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
Cells(i, 1) = fileName
Cells(i + 1, 2) = "Equity"
Cells(i + 2, 2) = "Forex NOOP"
Cells(i + 3, 2) = "Fixed Income Securities ( including CP, CD, G Sec)"
Cells(i + 4, 2) = "Total"
Cells(i, 2) = "Details"
Cells(i, 3) = "Limit"
Cells(i, 4) = "Min Var"
Cells(i, 5) = "Max Var"
Cells(i, 6) = "No. of Breaches"
Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G8:G8").Value
Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H8:H8").Value
Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I8:I8").Value
Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J8:J8").Value
i = i + 1
Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G9:G9").Value
Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H9:H9").Value
Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I9:I9").Value
Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J9:J9").Value
i = i + 1
Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G10:G10").Value
Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H10:H10").Value
Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I10:I10").Value
Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J10:J10").Value
i = i + 1
Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G11:G11").Value
Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H11:H11").Value
Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I11:I11").Value
Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J11:J11").Value
i = i + 1
currentWkbk.Close
End If
fileName = Dir
Loop
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
You can replace all your Cells lines with these 4
update: added line for coping formats
'other code
Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
Cells(i, 1) = fileName
Cells(i + 1, 2).Resize(4, 1) = Application.Transpose(Array("Equity", "Forex NOOP", "Fixed Income Securities ( including CP, CD, G Sec)", "Total"))
Cells(i, 2).Resize(1, 5) = Array("Details", "Limit", "Min Var", "Max Var", "No. of Breaches")
Cells(i + 1, 3).Resize(4, 4) = currentWkbk.Sheets("VaR").Range("G8:J11").Value
currentWkbk.Sheets("VaR").Range("G8:J11").Copy Cells(i + 1, 3)
currentWkbk.Close