If the image is part of your established signature, you can do that using Ron's sample(s) here: https://www.rondebruin.nl/win/s1/outlook/signature.htm
Posts by rory
-
-
Do you work in normal view or in page layout/page break preview?
-
Glad we could help.
-
You need to replace all the Target references with the cell of interest:
VBA
Display MoreSub Trap() If Worksheets("Sheet3").Range ("C34").Value = "Nee" Then Sheets("AB-BV-BF").Rows(46).Interior.ColorIndex = 16 Sheets("AB-BV-BF").Rows(65).Interior.ColorIndex = 16 Sheets("AB-BV-BF").Rows(66).Interior.ColorIndex = 16 Sheets("AB-BV-BF").Rows(67).Interior.ColorIndex = 16 ElseIf Worksheets("Sheet3").Range ("C34").Value = "Ja" Then Sheets("AB-BV-BF").Rows(46).Interior.ColorIndex = xlNone Sheets("AB-BV-BF").Rows(65).Interior.ColorIndex = xlNone Sheets("AB-BV-BF").Rows(66).Interior.ColorIndex = xlNone Sheets("AB-BV-BF").Rows(67).Interior.ColorIndex = xlNone End If End Sub -
You are using Target in your code but it is not declared and has no value. You should just refer to Worksheets("Sheet3").Range("C34") instead.
-
A Single can't return text, which is what you get with concatenating "i" to the end, and you can't round text either.
-
It's much easier if you can use an Outlook template message with the picture already embedded.
-
Add the line:
CodeMsgbox mAttachmentabove the line to add the attachment and verify the path and file name appear correctly.
-
This sort of thing is better in a database. With Access, you could use userforms in Excel to edit/update the data or simply distribute an Access front-end to everyone. With SQL server you can do the same or you can use something like Power Apps to create an app for the data work.
You can also do it with a workbook as the data source but it doesn't handle concurrent users quite as well - though with ADO you can mitigate that to some extent with batch updating and disconnected recordsets.
-
Do you have any sort of database program (eg Access or SQL Server)?
-
Is the worksheet protected?
-
You haven't indicated what you are actually doing with the arrays you create (your posted code is pointless), which makes it difficult to be sure what the best option is, but generally you would transpose the ca and da arrays while working with them - for example:
CodeReDim Preserve ca(4, c) ca(1, c) = Abs(a(i, 4)) ca(2, c) = a(i, 2) ca(3, c) = a(i, 1) ca(4, c) = a(i, 9) -
If you use Preserve you can only resize the upper bound of the last dimension.
-
What calculator are you using that returns -45 for that?
-
If you enable the Developer tab and click Design Mode (the blue triangle/set square button), can you then select the button in question?
-
What options do you get if you right-click it? Anything?
-
What kind of button are you referring to?
-
As Carim demonstrated, you just need to link the spinner to one of the cells and use a formula in the other cell (eg B2 =150-A1).
-
Great - glad we could help.
-
This should fix your text data issue:
Code
Display MoreSub Bank_CleanDataV3() ' Dim ArrayRow As Long, OutputRow As Long Dim BlankRows As Long, CurrentRow As Long Dim SheetRow As Long, StartRow As Long ' Dim OutputClosingBalanceColumnNumber As Long, OutputDateColumnNumber As Long Dim OutputDepositAmountColumnNumber As Long, OutputNarrationColumnNumber As Long Dim OutputLineColumnNumber As Long, OutputTallyLedgerColumnNumber As Long Dim OutputVoucherTypeColumnNumber As Long, OutputWithdrawalAmountColumnNumber As Long ' Dim SourceChqRefColumnNumber As Long, SourceClosingBalanceColumnNumber As Long Dim SourceConCatColumnNumber As Long, SourceDateColumnNumber As Long Dim SourceDepositAmountColumnNumber As Long Dim SourceNarrationColumnNumber As Long, SourceWithdrawalAmountColumn As Long ' Dim OutputCheckColumnLetter As String, OutputClosingBalanceColumnLetter As String Dim OutputDepositAmountColumnLetter As String, OutputWithdrawalAmountColumnLetter As String Dim SourceConCatColumnLetter As String, SourceDateColumnLetter As String Dim OutputLastColumnLetterInSheet As String Dim OutputEmptyColumnLetter As String Dim NewSheetName As String Dim HeaderArray As Variant, SourceArray As Variant, OutputArray() As Variant Dim SourceSheet As Worksheet, OutputSheet As Worksheet ' On Error Resume Next Sheets("CleanData").Delete Set SourceSheet = Worksheets("RawData") ' <-- Set this to the sheet to use for the input data ' OutputCheckColumnLetter = "J" ' <--- Set this to OutputCheckColumnLetter SourceConCatColumnLetter = "B" ' <--- Set this to the source column that needs Concat function SourceDateColumnLetter = "A" ' <--- Set this to source column of Dates NewSheetName = "CleanData" ' <--- Set this to the NewSheetName StartRow = 2 ' <--- Set this to the starting row of data ' OutputClosingBalanceColumnNumber = 9 ' <--- Set this to the OutputClosingBalanceColumnNumber OutputDateColumnNumber = 2 ' <--- Set this to the OutputDateColumnNumber OutputDepositAmountColumnNumber = 7 ' <--- Set this to the OutputDepositAmountColumnNumber OutputLineColumnNumber = 1 ' <--- Set this to the OutputLineColumnNumber OutputNarrationColumnNumber = 8 ' <--- Set this to the OutputNarrationColumnNumber OutputTallyLedgerColumnNumber = 5 ' <--- Set this to the OutputTallyLedgerColumnNumber OutputVoucherTypeColumnNumber = 3 ' <--- Set this to the OutputVoucherTypeColumnNumber OutputWithdrawalAmountColumnNumber = 6 ' <--- Set this to the OutputWithdrawalAmountColumn ' SourceChqRefColumnNumber = 3 ' <--- Set this to the SourceChqRefColumnNumber SourceClosingBalanceColumnNumber = 7 ' <--- Set this to the SourceClosingBalanceColumnNumber SourceDateColumnNumber = 1 ' <--- Set this to the SourceDateColumnNumber SourceDepositAmountColumnNumber = 6 ' <--- Set this to the SourceDepositAmountColumnNumber SourceNarrationColumnNumber = 2 ' <--- Set this to the SourceNarrationColumnNumber SourceWithdrawalAmountColumn = 5 ' <--- Set this to the SourceWithdrawalAmountColumn ' HeaderArray = Array("Line", "Date", "Voucher Type", "Voucher No.", _ "Tally Ledger Name", "Withdrawal Amt.", "Deposit Amt.", _ "Narration", "Closing Balance", "Check") ' <--- Set Array of headers to write to the created sheet ' Application.ScreenUpdating = False ' Turn ScreenUpdating off ' Sheets.Add(After:=SourceSheet).Name = NewSheetName ' Add new sheet after the sheet used for the input Set OutputSheet = Worksheets(NewSheetName) ' Set OutputSheet to the sheet to use for the output data ' SourceSheet.UsedRange.Copy OutputSheet.Range("A1") ' Copy SourceSheet to OutputSheet ' SourceConCatColumnNumber = OutputSheet.Range(SourceConCatColumnLetter & 1).Column ' Convert SourceConCatColumnLetter to SourceConCatColumnNumber SourceDateColumnNumber = OutputSheet.Range(SourceDateColumnLetter & 1).Column ' Convert SourceDateColumnLetter to SourceDateColumnNumber ' OutputLastColumnLetterInSheet = Split(OutputSheet.Cells(1, (OutputSheet.Cells.Find("*", _ , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1) ' Get last Column Letter used in Output sheet ' BlankRows = 0 ' Initialize BlankRows OutputRow = 0 ' Initialize OutputRow ' '----------------------------------------------------------------------------------- ' SourceArray = OutputSheet.Range("A" & StartRow & ":" & OutputLastColumnLetterInSheet & _ OutputSheet.Range(SourceConCatColumnLetter & Rows.Count).End(xlUp).Row).Value2 ' Save data from sheet into SourceArray ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To 1) ' Set OutputArray to same # of rows as the SourceArray ' For ArrayRow = 1 To UBound(SourceArray, 1) ' Loop through the rows of the SourceArray If SourceArray(ArrayRow, SourceDateColumnNumber) <> vbNullString Then ' If Date is not blank then ... OutputRow = OutputRow + 1 ' Increment OutputRow ' CurrentRow = OutputRow + BlankRows ' Get total of OutputRow + BlankRows and save to CurrentRow OutputArray(CurrentRow, 1) = SourceArray(ArrayRow, SourceConCatColumnNumber) ' Save Concat word to OutputArray(CurrentRow, 1) Else ' Else ... BlankRows = BlankRows + 1 ' Increment BlankRows OutputArray(CurrentRow, 1) = OutputArray(CurrentRow, 1) & _ " " & SourceArray(ArrayRow, SourceConCatColumnNumber) ' Append a space & next Concat word to OutputArray(CurrentRow, 1) End If Next ' Loop back ' '----------------------------------------------------------------------------------- ' With OutputSheet .Range(SourceConCatColumnLetter & StartRow & ":" & SourceConCatColumnLetter & _ .Range(SourceConCatColumnLetter & _ .Rows.Count).End(xlUp).Row).Value2 = OutputArray ' Write Concat column back to new sheet ' On Error Resume Next ' Ignore error in next line if no blank rows were found to delete .Columns("A").SpecialCells(xlBlanks).EntireRow.Delete ' If cell in used range of column A is blank then delete that row ' For SheetRow = .Cells(.Rows.Count, "A").End(xlUp).Row To StartRow Step -1 ' Loop backwards through the rows If Not IsDate(.Cells(SheetRow, 1)) Then _ .Cells(SheetRow, 1).EntireRow.Delete ' If cell in used range of Column A is not a date then delete row Next ' Loop back End With ' '----------------------------------------------------------------------------------- ' SourceArray = OutputSheet.Range("A" & StartRow & ":" & OutputLastColumnLetterInSheet & _ OutputSheet.Range(SourceDateColumnLetter & Rows.Count).End(xlUp).Row) ' Load Data from new sheet into SourceArray ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(HeaderArray) + 1) ' Set # of rows & columns for the OutputArray ' OutputSheet.UsedRange.Clear ' Erase the OutputSheet ' OutputRow = 0 ' Reset OutputRow ' For ArrayRow = 1 To UBound(SourceArray, 1) ' Loop through the rows of data in the SourceArray OutputRow = OutputRow + 1 ' OutputArray(ArrayRow, OutputLineColumnNumber) = ArrayRow ' Save the Line # to Column 1 of OutputArray OutputArray(ArrayRow, OutputDateColumnNumber) = _ SourceArray(ArrayRow, SourceDateColumnNumber) ' Save Date to Column 2 of OutputArray ' ' voucher type If SourceArray(ArrayRow, SourceWithdrawalAmountColumn) <> 0 Then ' If Withdrawal Amt. <> 0 then ... OutputArray(ArrayRow, OutputVoucherTypeColumnNumber) = "Payment" ' Put "Payment" in Column 3 of OutputArray ElseIf SourceArray(ArrayRow, SourceDepositAmountColumnNumber) <> 0 Then ' Else if Deposit Amt. <> 0 then ... OutputArray(ArrayRow, OutputVoucherTypeColumnNumber) = "Receipt" ' Put "Receipt" in Column 3 of OutputArray End If ' 'voucher # ' ??? ' ' 'Tally Ledger Name ' ??? OutputArray(ArrayRow, OutputTallyLedgerColumnNumber) = "Suspense in Bank" ' Not sure if this is supposed to be hard coded? ' OutputArray(ArrayRow, OutputWithdrawalAmountColumnNumber) = _ SourceArray(ArrayRow, SourceWithdrawalAmountColumn) ' Save Withdrawal Amount to Column 6 of OutputArray OutputArray(ArrayRow, OutputDepositAmountColumnNumber) = _ SourceArray(ArrayRow, SourceDepositAmountColumnNumber) ' Save Deposit Amount to Column 7 of OutputArray ' If SourceArray(ArrayRow, SourceChqRefColumnNumber) <> 0 Then ' If Chq./Ref.No. <> 0 then ... OutputArray(ArrayRow, OutputNarrationColumnNumber) = SourceArray(ArrayRow, _ SourceNarrationColumnNumber) & " Chq./Ref.No. " & _ SourceArray(ArrayRow, SourceChqRefColumnNumber) ' Save Narration & Chq./Ref.No. to Column 8 of OutputArray Else ' Else ... OutputArray(ArrayRow, OutputNarrationColumnNumber) = _ SourceArray(ArrayRow, SourceNarrationColumnNumber) ' Save Narration to Column 8 of OutputArray End If ' OutputArray(ArrayRow, OutputClosingBalanceColumnNumber) = _ SourceArray(ArrayRow, SourceClosingBalanceColumnNumber) ' Save Closing Balance to Column 9 of OutputArray Next ' Loop back ' '----------------------------------------------------------------------------------- ' With OutputSheet .Range("A1").Resize(, UBound(HeaderArray) + 1) = HeaderArray ' Write the array of headers to first row of new sheet .Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray ' Display OutputArray to new sheet starting on row 2 ' OutputLastColumnLetterInSheet = Split(.Cells(1, (.Cells.Find("*", _ , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1) ' Get last Column Letter used in Output sheet ' .Columns(OutputDateColumnNumber).NumberFormat = "dd-mm-yyyy" ' Set Date format of new sheet Column B to "dd-mm-yyyy" ' OutputClosingBalanceColumnLetter = Split(.Cells(1, _ OutputClosingBalanceColumnNumber).Address, "$")(1) ' Convert OutputClosingBalanceColumnNumber to OutputClosingBalanceColumnLetter OutputDepositAmountColumnLetter = Split(.Cells(1, _ OutputDepositAmountColumnNumber).Address, "$")(1) ' Convert OutputDepositAmountColumnNumber to OutputDepositAmountColumnLetter OutputWithdrawalAmountColumnLetter = Split(.Cells(1, _ OutputWithdrawalAmountColumnNumber).Address, "$")(1) ' Convert OutputWithdrawalAmountColumnNumber to OutputWithdrawalAmountColumnLetter ' With .Columns(OutputWithdrawalAmountColumnLetter & ":" & OutputDepositAmountColumnLetter) .Replace ",", "", xlPart .NumberFormat = "0.00" ' Set NumberFormat of Columns F:G on new sheet to 2 decimal places .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter End With ' With .Columns(OutputClosingBalanceColumnLetter & ":" & _ OutputCheckColumnLetter) .Replace ",", "", xlPart .NumberFormat = "#,##0.00" ' Format Columns I & J to commas & 2 decimal places End With .Range(OutputCheckColumnLetter & StartRow).Formula = "=RC[-1]" ' Set initial value of 'Check' column (J2) .Range(OutputCheckColumnLetter & StartRow + 1 & ":" & _ OutputCheckColumnLetter & .Range("A" & _ .Rows.Count).End(xlUp).Row).Formula = "=R[-1]C+RC[-3]-RC[-4]" ' Write rest of formulas to 'Check' column (J3 to last row) ' OutputEmptyColumnLetter = Split(.Cells(1, .Range(OutputLastColumnLetterInSheet & 1).Column _ + 1).Address, "$")(1) ' Convert OutputLastColumnNumberInSheet +1 to OutputEmptyColumnLetter ' .Columns(OutputCheckColumnLetter & ":" & OutputCheckColumnLetter).Copy ' Copy 'Check' Column .Columns(OutputEmptyColumnLetter & ":" & OutputEmptyColumnLetter).PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _ Transpose:=False ' Paste to blank helper column ' .Range(OutputCheckColumnLetter & StartRow & ":" & OutputCheckColumnLetter & _ .Range("A" & .Rows.Count).End(xlUp).Row).Formula = _ "=TRIM(INT(RC[1] * 100) / 100)" ' Write formulas to 'Check' column (J2 to last row) ' .Range(OutputCheckColumnLetter & StartRow & ":" & OutputCheckColumnLetter & _ .Range("A" & Rows.Count).End(xlUp).Row).Value = _ .Range(OutputCheckColumnLetter & StartRow & ":" & _ OutputCheckColumnLetter & .Range("A" & Rows.Count).End(xlUp).Row).Value ' Remove formulas from Column J in the new sheet leaving just the values ' .Columns(OutputEmptyColumnLetter & ":" & OutputEmptyColumnLetter).Delete ' Delete helper column ' ' With .UsedRange ' Format all Columns on the new sheet .Columns.Font.Name = "Calibri" .Columns.Font.Size = 11 .WrapText = False .Columns.AutoFit .Rows.AutoFit End With End With ' Application.ScreenUpdating = True ' Turn ScreenUpdating back on ' If Application.Round(OutputSheet.Range(OutputClosingBalanceColumnLetter & OutputSheet.Range("A" & _ Rows.Count).End(xlUp).Row), 2) = Application.Round(OutputSheet.Range(OutputCheckColumnLetter & _ OutputSheet.Range("A" & Rows.Count).End(xlUp).Row), 2) Then ' If last used cell in Column I = last used cell in Column J then ... MsgBox "Data cleaned & Matched Successfully" ' Display Matched message Else ' Else ... MsgBox "Mismatched. Check if any row is missed to enter" ' Display Mismatched message End If Application.DisplayAlerts = True Sheets("RawData").Select Range("B1").Select End Sub