please check my codes...they are working but they are lenghty...just i want these codes in short...
Posts by kamranyd
-
-
Code
Option Explicit Sub addata() ActiveSheet.Unprotect Dim Quot_No As String Dim Attn_Name As String Dim Co_Name As String Dim Quot_Date As String Dim Total_Price As String Dim Auth_Name As String Dim Des_CellB20 As String Dim Des_CellH20 As String Dim Des_CellI20 As String Dim Des_CellB21 As String Dim Des_CellH21 As String Dim Des_CellI21 As String Dim Des_CellB22 As String Dim Des_CellH22 As String Dim Des_CellI22 As String Dim Des_CellB23 As String Dim Des_CellH23 As String Dim Des_CellI23 As String Dim Des_CellB24 As String Dim Des_CellH24 As String Dim Des_CellI24 As String Dim Des_CellB25 As String Dim Des_CellH25 As String Dim Des_CellI25 As String Dim Des_CellB26 As String Dim Des_CellH26 As String Dim Des_CellI26 As String Dim Des_CellB27 As String Dim Des_CellH27 As String Dim Des_CellI27 As String Dim Des_CellB28 As String Dim Des_CellH28 As String Dim Des_CellI28 As String Dim Des_CellB29 As String Dim Des_CellH29 As String Dim Des_CellI29 As String Dim Des_CellB30 As String Dim Des_CellH30 As String Dim Des_CellI30 As String Dim Des_CellB31 As String Dim Des_CellH31 As String Dim Des_CellI31 As String Dim Des_CellB32 As String Dim Des_CellH32 As String Dim Des_CellI32 As String Dim Des_CellB33 As String Dim Des_CellH33 As String Dim Des_CellI33 As String Dim Des_CellB34 As String Dim Des_CellH34 As String Dim Des_CellI34 As String Dim Des_CellB35 As String Dim Des_CellH35 As String Dim Des_CellI35 As String Dim Des_CellB36 As String Dim Des_CellH36 As String Dim Des_CellI36 As String Dim Des_CellB37 As String Dim Des_CellH37 As String Dim Des_CellI37 As String Dim Des_CellB38 As String Dim Des_CellH38 As String Dim Des_CellI38 As String Dim Des_CellB39 As String Dim Des_CellH39 As String Dim Des_CellI39 As String Dim Des_CellB40 As String Dim Des_CellH40 As String Dim Des_CellI40 As String Dim Des_CellB41 As String Dim Des_CellH41 As String Dim Des_CellI41 As String Dim Des_CellB42 As String Dim Des_CellH42 As String Dim Des_CellI42 As String Dim Des_CellB43 As String Dim Des_CellH43 As String Dim Des_CellI43 As String Dim Des_CellB44 As String Dim Des_CellH44 As String Dim Des_CellI44 As String Dim Des_CellB45 As String Dim Des_CellH45 As String Dim Des_CellI45 As String Dim Des_CellB46 As String Dim Des_CellH46 As String Dim Des_CellI46 As String Dim Des_CellB47 As String Dim Des_CellH47 As String Dim Des_CellI47 As String Dim Des_CellB48 As String Dim Des_CellH48 As String Dim Des_CellI48 As String Dim Des_CellB49 As String Dim Des_CellH49 As String Dim Des_CellI49 As String Dim Des_CellB50 As String Dim Des_CellH50 As String Dim Des_CellI50 As String Dim Des_CellB51 As String Dim Des_CellH51 As String Dim Des_CellI51 As String Dim Des_CellB52 As String Dim Des_CellH52 As String Dim Des_CellI52 As String Dim Des_CellB53 As String Dim Des_CellH53 As String Dim Des_CellI53 As String Dim Des_CellB54 As String Dim Des_CellH54 As String Dim Des_CellI54 As String Dim Des_CellB55 As String Dim Des_CellH55 As String Dim Des_CellI55 As String Worksheets("QUOT").Select Application.ScreenUpdating = False Quot_No = Range("B10") If Len(Worksheets("QUOT").Range("B10").Value) = 0 Then MsgBox "Please enter quotation number", vbInformation, "Quotation Number Error" Application.Goto Worksheets("QUOT").Range("B10") Exit Sub End If Attn_Name = Range("B13") If Len(Worksheets("QUOT").Range("B13").Value) = 0 Then MsgBox "Please enter receiver name", vbInformation, "Quotation Receiver Name Error" Application.Goto Worksheets("QUOT").Range("B13") Exit Sub End If Co_Name = Range("C15") If Len(Worksheets("QUOT").Range("C15").Value) = 0 Then MsgBox "Please enter Company / Customer name", vbInformation, "Quotation Company / Customer Name Error" Application.Goto Worksheets("QUOT").Range("C15") Exit Sub End If Quot_Date = Range("J13") If Len(Worksheets("QUOT").Range("J13").Value) = 0 Then MsgBox "Please enter quotation date", vbInformation, "Quotation Date Error" Application.Goto Worksheets("QUOT").Range("J13") Exit Sub End If Total_Price = Range("J58") If Len(Worksheets("QUOT").Range("J58").Value) = 0 Then MsgBox "Please enter quotation Price", vbInformation, "Quotation Price Error" Application.Goto Worksheets("QUOT").Range("J58") Exit Sub End If Auth_Name = Range("H65") If Len(Worksheets("QUOT").Range("H65").Value) = 0 Then MsgBox "Please select authorize person name", vbInformation, "Quotation Authorization Error" Application.Goto Worksheets("QUOT").Range("H65") Exit Sub End If Des_CellB20 = Range("B20") Des_CellH20 = Range("H20") Des_CellI20 = Range("I20") Des_CellB21 = Range("B21") Des_CellH21 = Range("H21") Des_CellI21 = Range("I21") Des_CellB22 = Range("B22") Des_CellH22 = Range("H22") Des_CellI22 = Range("I22") Des_CellB23 = Range("B23") Des_CellH23 = Range("H23") Des_CellI23 = Range("I23") Des_CellB24 = Range("B24") Des_CellH24 = Range("H24") Des_CellI24 = Range("I24") Des_CellB25 = Range("B25") Des_CellH25 = Range("H25") Des_CellI25 = Range("I25") Des_CellB26 = Range("B26") Des_CellH26 = Range("H26") Des_CellI26 = Range("I26") Des_CellB27 = Range("B27") Des_CellH27 = Range("H27") Des_CellI27 = Range("I27") Des_CellB28 = Range("B28") Des_CellH28 = Range("H28") Des_CellI28 = Range("I28") Des_CellB29 = Range("B29") Des_CellH29 = Range("H29") Des_CellI29 = Range("I29") Des_CellB30 = Range("B30") Des_CellH30 = Range("H30") Des_CellI30 = Range("I30") Des_CellB31 = Range("B31") Des_CellH31 = Range("H31") Des_CellI31 = Range("I31") Des_CellB32 = Range("B32") Des_CellH32 = Range("H32") Des_CellI32 = Range("I32") Des_CellB33 = Range("B33") Des_CellH33 = Range("H33") Des_CellI33 = Range("I33") Des_CellB34 = Range("B34") Des_CellH34 = Range("H34") Des_CellI34 = Range("I34") Des_CellB35 = Range("B35") Des_CellH35 = Range("H35") Des_CellI35 = Range("I35") Des_CellB36 = Range("B36") Des_CellH36 = Range("H36") Des_CellI36 = Range("I36") Des_CellB37 = Range("B37") Des_CellH37 = Range("H37") Des_CellI37 = Range("I37") Des_CellB38 = Range("B38") Des_CellH38 = Range("H38") Des_CellI38 = Range("I38") Des_CellB39 = Range("B39") Des_CellH39 = Range("H39") Des_CellI39 = Range("I39") Des_CellB40 = Range("B40") Des_CellH40 = Range("H40") Des_CellI40 = Range("I40") Des_CellB41 = Range("B41") Des_CellH41 = Range("H41") Des_CellI41 = Range("I41") Des_CellB42 = Range("B42") Des_CellH42 = Range("H42") Des_CellI42 = Range("I42") Des_CellB43 = Range("B43") Des_CellH43 = Range("H43") Des_CellI43 = Range("I43") Des_CellB44 = Range("B44") Des_CellH44 = Range("H44") Des_CellI44 = Range("I44") Des_CellB45 = Range("B45") Des_CellH45 = Range("H45") Des_CellI45 = Range("I45") Des_CellB46 = Range("B46") Des_CellH46 = Range("H46") Des_CellI46 = Range("I46") Des_CellB47 = Range("B47") Des_CellH47 = Range("H47") Des_CellI47 = Range("I47") Des_CellB48 = Range("B48") Des_CellH48 = Range("H48") Des_CellI48 = Range("I48") Des_CellB49 = Range("B49") Des_CellH49 = Range("H49") Des_CellI49 = Range("I49") Des_CellB50 = Range("B50") Des_CellH50 = Range("H50") Des_CellI50 = Range("I50") Des_CellB51 = Range("B51") Des_CellH51 = Range("H51") Des_CellI51 = Range("I51") Des_CellB52 = Range("B52") Des_CellH52 = Range("H52") Des_CellI52 = Range("I52") Des_CellB53 = Range("B53") Des_CellH53 = Range("H53") Des_CellI53 = Range("I53") Des_CellB54 = Range("B54") Des_CellH54 = Range("H54") Des_CellI54 = Range("I54") Des_CellB55 = Range("B55") Des_CellH55 = Range("H55") Des_CellI55 = Range("I55") Worksheets("database").Select Worksheets("database").Range("A2").Select If Worksheets("database").Range("A2").Offset(1, 0) <> "" Then Worksheets("database").Range("A2").End(xlDown).Select End If ActiveCell.Offset(1, 0).Select ActiveCell.Value = Quot_No ActiveCell.Offset(0, 1).Select ActiveCell.Value = Quot_Date ActiveCell.Offset(0, 1).Select ActiveCell.Value = Attn_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = Co_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = Total_Price ActiveCell.Offset(0, 1).Select ActiveCell.Value = Auth_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB20 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH20 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI20 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB21 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH21 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI21 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB22 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH22 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI22 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB23 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH23 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI23 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB24 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH24 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI24 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB25 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH25 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI25 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB26 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH26 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI26 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB27 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH27 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI27 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB28 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH28 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI28 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB29 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH29 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI29 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB30 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH30 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI30 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB31 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH31 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI31 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB32 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH32 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI32 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB33 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH33 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI33 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB34 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH34 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI34 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB35 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH35 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI36 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB37 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH37 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI37 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB38 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH38 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI38 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB39 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH39 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI39 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB40 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH40 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI40 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB41 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH41 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI41 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB42 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH42 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI42 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB43 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH43 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI43 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB44 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH44 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI44 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB45 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH45 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI45 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB46 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH46 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI46 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB47 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH47 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI47 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB48 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH48 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI48 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB49 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH49 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI49 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB50 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH50 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI50 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB51 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH51 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI51 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB52 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH52 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI52 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB53 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH53 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI53 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB54 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH54 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI54 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellB55 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellH55 ActiveCell.Offset(0, 1).Select ActiveCell.Value = Des_CellI55 ActiveCell.Offset(0, 1).Select Worksheets("QUOT").Select Worksheets("QUOT").Range("B10").Select Range("J13").ClearContents Range("B13").MergeArea.ClearContents Range("C15").MergeArea.ClearContents Range("H65").MergeArea.ClearContents MsgBox "Quotation Has Been Submitted to Database", vbInformation, "Al-Maliki Mechanical Engineering." Sheets("QUOT").Range("B10").Value = _ Sheets("QUOT").Range("B10").Value + 1 ActiveSheet.Protect End Sub
i m using these codes for data transfer but its very long.. i want to make it short so it can execute quick.
help will be appreciated.Thannks
-
Code
Display MoreSub transfer() Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long Dim myname As String lastrow1 = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row Worksheets("Sheet1").Select Application.ScreenUpdating = False For i = 2 To lastrow1 myname = Sheets("sheet1").Cells(i, "A").Value Sheets("sheet2").Activate lastrow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row For j = 2 To lastrow2 If Sheets("sheet2").Cells(j, "A").Value = myname Then Sheets("sheet1").Activate Sheets("sheet1").Range(Cells(i, "B"), Cells(i, "G")).Copy Sheets("sheet2").Activate Sheets("sheet2").Range(Cells(j, "B"), Cells(j, "C")).Select ActiveSheet.Paste End If Next j Application.CutCopyMode = False Next i Sheets("sheet2").Activate Sheets("sheet2").Range("A1").Select End Sub
can somebody help with these codes which extract data as per given names. i want help to copy from anywhere cells i want and copy in another sheet anywhere cell i want wo which part of codes i shall change. Thanks
-
Code
Private Sub CommandButton1_Click() Dim User_Name As String, Co_Name As String, User_ID As String, Phone_Number As Double, Problem_ID As String Worksheets("Sheet1").Select User_Name = Range("B2") Cstm_Name = Range("I8") Co_Name = Range("B3") User_ID = Range("B4") Phone_Number = Range("B5") Problem_ID = Range("B6") Worksheets("Sheet2").Select Worksheets("Sheet2").Range("A1").Select If Worksheets("Sheet2").Range("A1").Offset(1, 0) <> "" Then Worksheets("Sheet2").Range("A1").End(xlDown).Select End If ActiveCell.Offset(1, 0).Select ActiveCell.Value = User_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = Co_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = Cstm_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = User_ID ActiveCell.Offset(0, 1).Select ActiveCell.Value = Phone_Number ActiveCell.Offset(0, 1).Select ActiveCell.Value = Problem_ID Worksheets("Sheet1").Select Worksheets("Sheet1").Range("B2").Select End Sub
These codes copy data from 1 sheet to another sheet. plz if you help me. i want data copy codes + if data cell is blank it should give me message for input + previous cell should be clear after data get copy but i can modify it whatever cell i want to be clear. and before copy it should check if the same data is already available than dont copy. like same invoice number than dont copy that. i want codes should be easy to modify so i can add more cells or remove them. i hope you understood...
-
sorry actually this is 1st time i joined some forum pages....ok i submit new topic and ask for help
-
Code
Display MorePrivate Sub CommandButton1_Click() Dim User_Name As String, Co_Name As String, User_ID As String, Phone_Number As Double, Problem_ID As String Worksheets("Sheet1").Select User_Name = Range("B2") Cstm_Name = Range("I8") Co_Name = Range("B3") User_ID = Range("B4") Phone_Number = Range("B5") Problem_ID = Range("B6") Worksheets("Sheet2").Select Worksheets("Sheet2").Range("A1").Select If Worksheets("Sheet2").Range("A1").Offset(1, 0) <> "" Then Worksheets("Sheet2").Range("A1").End(xlDown).Select End If ActiveCell.Offset(1, 0).Select ActiveCell.Value = User_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = Co_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = Cstm_Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = User_ID ActiveCell.Offset(0, 1).Select ActiveCell.Value = Phone_Number ActiveCell.Offset(0, 1).Select ActiveCell.Value = Problem_ID Worksheets("Sheet1").Select Worksheets("Sheet1").Range("B2").Select End Sub
these codes copy data from 1 sheet to another sheet CAN YOU PLZ WRITE CODES IN THESE THAT CELL SHOULD NOT BE BLANK CODE BEFORE COPY DATA
-
thanks a lot Trebor76. i m gud at design not at writing codes.really thanks again
-
-
can somebody help me.
i need button which can generator invoice number
and also restriction to number