• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

problem with code

B

bachuwar.rajenderprasad

New Member
Sub VB_Yes_No()
Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String
QuestionToMessageBox = "Do you Really want to execute through Database?"
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "VBA Expert or Not")
If YesOrNoAnswerToMessageBox = vbNo Then
Call Create_File
Else
Call Inset_Query
End If
End Sub

Sub Inset_Query()
' This will help us in executing all the queries in Database which are held in Payment sheet Column N4
Dim SQL_String As String
Dim rs As ADODB.Recordset 'This holds the data
Dim cn As ADODB.Connection 'Declaring Connection
Dim cmdobj As ADODB.Command 'Declare command Object
'Sheets("Payment").Select
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open ("Provider=MSDAORA;Data Source=Mydata;User ID=prasa; Password=prasad;")
Dim count_value As Long
count_value = WorksheetFunction.CountA(Worksheets("Payments").Range("A:A"))
For i = 4 To count_value
SQL_String = Worksheets("Payments").Range("N" & i).Value
rs.Open SQL_String, cn
cn.Execute SQL_String
cn.CommitTrans
Worksheets("Payments").Range("AZ" & i).Value = "Yes"
Set cn = Nothing
Next
cn.Close
End Sub

Sub Select_Query()
Dim SQL_String As String
Dim rs As ADODB.Recordset 'This holds the data
Dim cn As ADODB.Connection 'Declaring Connection
Dim cmdobj As ADODB.Command 'Declare command Object
'Sheets("Payment").Select
Set cn = New ADODB.Connection
cn.Open ("Provider=MSDAORA;Data Source=Mydata;User ID=prasa; Password=prasad;")
Dim count_value As Long
count_value = WorksheetFunction.CountA(Worksheets("Payments").Range("A:A"))
For i = 4 To count_value
SQL_String = Worksheets("Payments").Range("AA" & i).Value
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
MsgBox SQL_String
rs.Open SQL_String, cn
Dim val As Integer
val = rs.RecordCount
If val = 0 Then
Worksheets("Payments").Range("AZ" & i).Value = "No"
'Else
'Worksheets("Uploaded").Range("O" & i).Value = "Yes"
End If
cn.Close
'Set cn = Nothing
Next
'cn.Execute SQL_String
'con.Close
'Set con = Nothing
End Sub

Sub Browse_File()
If IsEmpty(Range("F9").Value) Or IsEmpty(Range("F10").Value) Then
MsgBox (" Fields F9 and F10 are blank, please make it fill")
Else
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to import")
''
If FileToOpen = False Then
MsgBox "No file specified.", vbExclamation, "Duh!!!"
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
'Workbooks.Open "C:Mytemplate.xlsx"
End If
Range("A1").Select
With ActiveSheet
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:R" & lastrow).Copy
Workbooks("Saved_Copy of Manual Payment Upload.xlsm").Activate
Worksheets("Uploaded").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("o2").Select
End With
Worksheets("Uploaded").Range("O1").Value = "Status"
End If
'With Worksheets("Master").Rectangles
' .OnAction = "CODING"
'.Caption = "MAIN MENU"
'.Font.Size = 25
'.Font.Underline = xlUnderlineStyleSingle
'.Name = "CODING"
'.Interior.Color = RGB(255, 255, 255)
' .Border.Color = RGB(255, 255, 255)
'End With
Worksheets("Master").Activate
End Sub

Sub Specify_Yes_No()
Range("B2").Select
Dim count_value As Long
'count_value = WorksheetFunction.CountA(Worksheets("Uploaded").Range("A:A"))
count_value = Worksheets("Uploaded").UsedRange.Rows.Count
For i = 2 To count_value
'If Worksheets("Uploaded").Range("E" & i).Value <> "" Then
'Worksheets("Uploaded").Range("E" & i).Value = (Worksheets("Uploaded").Range("A" & i).Value) & WorksheetFunction.Text((Worksheets("Uploaded").Range("D" & i).Value), "mmdd")
'End If
If Worksheets("Uploaded").Range("F" & i).Value = "" Then
Worksheets("Uploaded").Range("F" & i).Value = "CNTR"
Worksheets("Uploaded").Range("O" & i).Value = "Yes"
End If
If Worksheets("Uploaded").Range("G" & i).Value = "" Then
Worksheets("Uploaded").Range("G" & i).Value = "Revenue"
Worksheets("Uploaded").Range("O" & i).Value = "Yes"
End If
If Worksheets("Uploaded").Range("B" & i).Value <> "" And Worksheets("Uploaded").Range("D" & i).Value <> "" And Worksheets("Uploaded").Range("F" & i).Value <> "" And Worksheets("Uploaded").Range("G" & i).Value <> "" And Worksheets("Uploaded").Range("H" & i).Value <> "Chek" And Worksheets("Uploaded").Range("N" & i).Value <> "" Then
Worksheets("Uploaded").Range("O" & i).Value = "Yes"
Else
Worksheets("Uploaded").Range("O" & i).Value = "No"
End If
If Worksheets("Uploaded").Range("H" & i).Value = "Chq" Then
If Worksheets("Uploaded").Range("I" & i).Value = "" Then
Worksheets("Uploaded").Range("O" & i).Value = "No"
'Worksheets("Uploaded").Range("O" & i).Value = "No"
ElseIf Worksheets("Uploaded").Range("j" & i).Value = "" Then
Worksheets("Uploaded").Range("O" & i).Value = "No"
ElseIf Worksheets("Uploaded").Range("K" & i).Value = "" Then
Worksheets("Uploaded").Range("O" & i).Value = "No"
ElseIf Worksheets("Uploaded").Range("L" & i).Value = "" Then
Worksheets("Uploaded").Range("O" & i).Value = "No"
End If
End If
Next
Dim SQL_String As String
Dim rs As ADODB.Recordset 'This holds the data
Dim cn As ADODB.Connection 'Declaring Connection
Dim cmdobj As ADODB.Command 'Declare command Object
Dim val As Integer
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
For i = 2 To count_value
cn.Open ("Provider=MSDAORA;Data Source=Mydata;User ID=prasa; Password=prasad;")
SQL_String = "Select Acct_id from CI_ACCT where ACCT_ID=" & Worksheets("Uploaded").Range("B" & i) & ""
On Error GoTo e1
rs.Open SQL_String, cn, adOpenForwardOnly, adLockReadOnly
'If rs.EOF Then
'MsgBox "record empty,rs.EOF" & rs.EOF
'Else
'MsgBox "record empty,rs.EOF" & rs.recordCount
'End If
val = rs.RecordCount
If val = 0 Then
Worksheets("Uploaded").Range("O" & i).Value = "No"
'Else
'Worksheets("Uploaded").Range("O" & i).Value = "Yes"
End If
'Set cn = Nothing
Next
cn.Close
Set cn = Nothing
Application.ScreenUpdating = False
Worksheets("Uploaded").Range("d:d").NumberFormat = "M/D/yy;@"
Application.ScreenUpdating = True
e1:
Worksheets("Uploaded").Range("O" & i).Value = "No"
Resume Next
'Set count_value = Nothing
End Sub

Sub After_Validation()
Worksheets("Uploaded").Activate
Selection.AutoFilter
ActiveSheet.Range("$A:$O").AutoFilter Field:=15, Criteria1:="=Yes", _
Operator:=xlAnd
Cells.Copy
Sheets("After Validation").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Uploaded").Activate
Selection.AutoFilter
ActiveSheet.Range("$A:$O").AutoFilter Field:=15, Criteria1:="=No", _
Operator:=xlAnd
Cells.Copy
Sheets("Invalid Records").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Sub Correct_Append()
Range("B2").Select
Dim count_value As Long
'count_value = WorksheetFunction.CountA(Worksheets("Uploaded").Range("A:A"))
count_value = Worksheets("Invalid Records").UsedRange.Rows.Count
For i = 2 To count_value
If Worksheets("Invalid Records").Range("F" & i).Value = "" Then
Worksheets("Invalid Records").Range("F" & i).Value = "CNTR"
Worksheets("Invalid Records").Range("O" & i).Value = "Yes"
End If
If Worksheets("Invalid Records").Range("G" & i).Value = "" Then
Worksheets("Invalid Records").Range("G" & i).Value = "Revenue"
Worksheets("Invalid Records").Range("O" & i).Value = "Yes"
End If
If Worksheets("Invalid Records").Range("B" & i).Value <> "" And Worksheets("Invalid Records").Range("D" & i).Value <> "" And Worksheets("Invalid Records").Range("E" & i).Value <> "" And Worksheets("Invalid Records").Range("F" & i).Value <> "" And Worksheets("Invalid Records").Range("G" & i).Value <> "" And Worksheets("Invalid Records").Range("H" & i).Value <> "Chek" And Worksheets("Invalid Records").Range("N" & i).Value <> "" Then
Worksheets("Invalid Records").Range("O" & i).Value = "Yes"
Else
Worksheets("Invalid Records").Range("O" & i).Value = "No"
End If
If Worksheets("Invalid Records").Range("H" & i).Value = "Chek" Then
If Worksheets("Invalid Records").Range("I" & i).Value = "" Then
Worksheets("Invalid Records").Range("O" & i).Value = "No"
'Worksheets("Uploaded").Range("O" & i).Value = "No"
ElseIf Worksheets("Invalid Records").Range("j" & i).Value = "" Then
Worksheets("Invalid Records").Range("O" & i).Value = "No"
ElseIf Worksheets("Invalid Records").Range("K" & i).Value = "" Then
Worksheets("Invalid Records").Range("O" & i).Value = "No"
ElseIf Worksheets("Invalid Records").Range("L" & i).Value = "" Then
Worksheets("Invalid Records").Range("O" & i).Value = "No"
End If
End If
Next
Application.ScreenUpdating = False
Worksheets("Invalid Records").Range("d:d").NumberFormat = "M/D/yy;@"
Application.ScreenUpdating = True
Dim count_val As Long
Dim lastrow As Long
Dim lastrow1 As Long
count_val1 = Worksheets("After Validation").UsedRange.Rows.Count
count_value = Worksheets("Invalid Records").UsedRange.Rows.Count
Range("A2:O" & count_value).Select
Selection.Copy
Sheets("After Validation").Select
lastrow = Worksheets("After Validation").Cells(Rows.Count, "A").End(xlUp).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Sub Copy_paste_payment()
Worksheets("Payments").Activate
Dim count_value As Long
count_value = Worksheets("Payments").UsedRange.Rows.Count
Range("A4:M" & count_value).Select
Selection.ClearContents
Worksheets("After Validation").Activate
Range("L:L,O:O").Select
Selection.Delete shift:=xlToLeft
Columns("M:M").Select
Selection.Cut
Columns("L:L").Select
Selection.Insert shift:=xlToRight
Dim count_val As Long
count_val = Worksheets("After Validation").UsedRange.Rows.Count
Range("A2:L" & count_val).Select
Selection.Copy
Sheets("Payments").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = False
Worksheets("Payments").Range("d:d").NumberFormat = "M/D/yy;@"
Application.ScreenUpdating = True
Worksheets("Payments").Range("L2").Value = Application.WorksheetFunction.Sum(Range("L4:L" & count_val))
Call formulation
End Sub

Sub formulation()
Dim count_value As Long
count_value = Worksheets("Payments").UsedRange.Rows.Count
MsgBox count_value
Worksheets("Payments").Range("C4:C" & count_value).FormulaR1C1 = "=REPT(0,(6-LEN(RC[6])))&RC[6]"
Worksheets("Payments").Range("N4:N" & count_value).FormulaR1C1 = "=""INSERT INTO CI_PAY_TNDR_ST VALUES ('""&RC[4]&""','""&RC[5]&""','""&RC[6]&""',SUBSTR('""&RC[7]&""',1,30),'""&RC[8]&""','""&RC[9]&""','""&RC[10]&""',to_date('""&RC[11]&""','dd/mm/yyyy'),'""&RC[12]&""',(""&RC[13]&""),SUBSTR('""&RC[14]&""',1,30),'""&RC[15]&""','""&RC[16]&""','""&RC[17]&""')"""
Worksheets("Payments").Range("O4").FormulaR1C1 = "=""INSERT INTO CI_TNDR_CTL_ST VALUES ('""&RC[18]&""','""&RC[19]&""','""&RC[20]&""','""&RC[21]&""','""&RC[22]&""','""&RC[23]&""','""&RC[24]&""','""&RC[25]&""');"""
Worksheets("Payments").Range("P4").FormulaR1C1 = "=""INSERT INTO CI_DEP_CTL_ST VALUES ('""&RC[26]&""','""&RC[27]&""','""&RC[28]&""','""&RC[29]&""',to_date('""&RC[30]&""','dd/mm/yyyy'),'""&RC[31]&""','""&RC[32]&""','""&RC[33]&""','""&RC[34]&""','""&RC[35]&""');"""
Worksheets("Payments").Range("Q4:Q" & count_value).FormulaR1C1 = "=IF(RC[-16],1)"
Worksheets("Payments").Range("R4:R" & count_value).Value = Sheets("Master").Range("F9")
'Worksheets("Payments").Range("R4:R" & count_value).FormulaR1C1 = "=Master!R[5]C[-12]"
Worksheets("Payments").Range("S4:S" & count_value).FormulaR1C1 = "=RC[-1]&""D""&TEXT(RC[-15],""DDMMyyyy"")&Master!R10C6"
'Worksheets("Payments").Range("S4:S" & count_value).value= =R4&"D"&TEXT(D4,"DDMMyyyy")&Master!F10
'Worksheets("Payments").Worksheets("Payments").Range("T4").Copy
Worksheets("Payments").Select
Range("T4").Copy
Worksheets("Payments").Range("T5:T" & count_value).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Payments").Range("U4:U" & count_value).FormulaR1C1 = "=""C""&RC[-15]&""R""&RC[-16]"
Worksheets("Payments").Range("V4:V" & count_value).FormulaR1C1 = "=IF(RC[-21],""10"")"
Worksheets("Payments").Range("X4:X" & count_value).FormulaR1C1 = "=RC[-12]"
Worksheets("Payments").Range("Y4:Y" & count_value).FormulaR1C1 = "=IF(RC[-21],TEXT(RC[-21],""DD/MM/yyyy""))"
Worksheets("Payments").Range("Z4:Z" & count_value).FormulaR1C1 = _
"=IF(AND(RC[-18]=""C"",RC[-20]=""22""),""ECS"",IF(AND(RC[-18]=""C"",RC[-20]<>""22""),""CASH"",IF(RC[-18]=""CHQ"",""CHEK"",IF(RC[-18]=""DD"",""DRAF"",IF(RC[-18]=""CC"",""CC"")))))"
Worksheets("Payments").Range("AA4:AA" & count_value).FormulaR1C1 = _
"=""SELECT sa.acct_id" & Chr(10) & " FROM ci_sa sa, ci_sp sp, ci_sa_sp ss, ci_sp_geo spg,ci_acct_char cac" & Chr(10) & " WHERE sa.sa_id = ss.sa_id" & Chr(10) & " AND ss.sp_id = sp.sp_id" & Chr(10) & " AND sp.sp_id = spg.sp_id" & Chr(10) & " AND spg.geo_type_cd LIKE '%RR%'" & Chr(10) & " AND spg.geo_val ='""&RC[-25]&""' " & Chr(10) & " and sa.ACCT_ID=cac.ACCT_ID" & Chr(10) & " AND cac.char_type_cd LIKE '%SDO%'" & Chr(10) & " AND TRIM (char_val) IN ('""&Master!R[5]C[-20]&""')"""
Worksheets("Payments").Range("AB4:AB" & count_value).FormulaR1C1 = _
"=IF(RC[-19],RC[-25]&""-""&TEXT(RC[-18],""DDMMYYYY"")&""-""&RC[-15]&RC[-17],"" "")"
Worksheets("Payments").Range("AD4:AD" & count_value).FormulaR1C1 = "=RC[-27]"
Worksheets("Payments").Range("AE4:AE" & count_value).FormulaR1C1 = "=IF(RC[-30],""1"")"
Worksheets("Payments").Range("AG4:AG" & count_value).FormulaR1C1 = "=CONCATENATE(RC[-15])"
Worksheets("Payments").Range("AH4:AH" & count_value).FormulaR1C1 = "=CONCATENATE(RC[-16])"
Worksheets("Payments").Range("AI4:AI" & count_value).FormulaR1C1 = "=CONCATENATE(RC[-16])"
Worksheets("Payments").Range("AL4:AL" & count_value).FormulaR1C1 = "=SUM(R[-2]C[-26])"
Worksheets("Payments").Range("AM4:AM" & count_value).FormulaR1C1 = "=SUM(R[-2]C[-22])"
Worksheets("Payments").Range("AP4:AP" & count_value).FormulaR1C1 = "=CONCATENATE(RC[-24])"
Worksheets("Payments").Range("AQ4:AQ" & count_value).FormulaR1C1 = "=CONCATENATE(RC[-24])"
Worksheets("Payments").Range("AT4:AT" & count_value).FormulaR1C1 = "=RC[-21]"
Worksheets("Payments").Range("AV4:AV" & count_value).FormulaR1C1 = "=SUM(R[-2]C[-36])"
End Sub

Sub Create_File()
Dim sFile As String
Dim sText As String
Dim iFileNum As Integer
Dim count_val As Long
count_val = Worksheets("Payments").UsedRange.Rows.Count
sFile = "C:Usersrajender_prasadDesktopTextfile.sql"
'MsgBox sText
iFileNum = FreeFile
Open sFile For Output As iFileNum
For i = 4 To count_val
sText = Worksheets("Payments").Range("N" & i).Value & ";"
Print #iFileNum, sText
'Print #iFileNum, "More text on next line"
'Print #iFileNum, "Etc."
Next
Close #iFileNum
MsgBox "file is created " & sFile
End Sub
 
Hi Prasad ,


Do you seriously expect any expert to go through the code , deduce what problems you are facing with it , and suggest solutions ?


I think such experts are available , but their time is money.


I think the least you can do , is upload your workbook with the data , indicating what are the problems you are facing with the code in its present form.


Narayan
 
Prasad


Along with Narayan's comment, you haven't even described the problem and what you are seeing go wrong and what it should do.


Please help us to help you by reading the Green Post: http://chandoo.org/forums/topic/phd-forum-posting-rules-etiquette-pls-read-before-posting
 
I am no VBA expert (not even a novice if honest) but surly Prasad would have stepped through the code in the VBA editor or received warnings about the code when he compiled it. How can you post such an amount of code without the workbook? (are Ninjas mind readers as well). If a Ninja was able to read the code he could not run it without all the worksheets required. How can anyone replicate the problem if they do not know what it is?
 
Hi, Prasad!

Besides all previous comments (more than right, more than logical, more than all) when you post code it'd be useful for those who read your comment if you embed it within backticks (`) as stated at the bottom of the Reply section of each topic. In this way you preserve original formatting which it's supposed to help on clearness; now if your code actually looks like how appeared at your post, you're in deeper troubles.

The longer the code, the more required this method.

Regards!
 
Taking SirJB7's comment, I've edited the original post to code format. Sadly, there's not a lot of indentation. It did become apparent that there are several macro involved, instead of just 1. Looking at all those statements, I'm guessing there's a PICNIC error.
 
Hi, all!

Following Luke M's motivating idea I edited the original posted code too. My best shot and I still don't like the code.

Regards!

PS: Disagree with the PICNIC error only, I'm more inclined to think about a whole Spring season outdoor activities.
 
Good evening Like M and nice to see you back SirJB7


Luke M there are a few at my works who are going to receive emails with ID-10-T Error in reply to their feeble attempts to blame anything and any one but them selves when excel goes tits up
 
Thanks for cleaning that up SirJB7. Much easier to read, at least. 10 separate macros though, wow.
 
@Luke M

Hi!

Should I add no Option Explicit for variable name and type declaration, no reference documentation (needs Microsoft Active X Data Objects nn.nn Library to compile), not enough comment lines, no structure for declaration statements position, nearly no With use, no worksheet qualification in not private procedures so take care which sheet is selected, ...?

Regards!
 
You must log in or register to reply here.
Back
Top