Posts by JJeffery99

Hi all, I am looking to highlight each cell based on the value to the left. Hopefully without having to create a rule for every column. The example is if b2 is greater than a2, then it will be highlighted green. And if c2 is less than b2 it will be highlighted red and so forth. How would i do this?

Awesome that worked! Thank you for this

Hi all,

I have attached the document for you to review and I'm struggling to work out how I would go about removing all companies names which don't appear at least 4 times in column A on the attached. So as an example 1313 Global would remain on the list but Altered States FX Limited in row 1288 would be removed as it only appears once, same goes for the next two companies after that.

Once i have removed all companies that don't appear at least 4 times, I will then remove duplicates which i can do so i have a lsit of companies who have appeared at least 4 times in the list.

Any advice would be appreciated.

thanks Roy,

I edited it slightly but that works perfectly now! Thanks so much for your help. I am looking to learn more about excel coding, is there a place you recommend i should start learning from at all?

Hi Roy,

Please see the attached!

Hi Roy,

Thanks for assisting i appreciate the help, it still says mismatch on that line as an error code. Is it a problem with the code as a whole or?

Kind regards

' Define PDF filename
PdfFile = Application.InputBox("Please provide a name for the PDF")
If PdfFile = False or PdfFile = "" Then
MsgBox "No name provided"
Exit Sub
End If

Hi Roy,

This would work perfectly but the only issue is it says mismatch error on the line 3 of the code you provided. I am not sure how this is fixed.

Thanks for your help!

Hi all,

I have the attached code currently to send my activesheet as a pdf in an email. Please can someone advise a fix for me to choose a custom filename instead of it being the document name?

Thanks,

Joe

Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object


' Not sure for what the Title is
Title = Range("A1")


' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & ".pdf"


' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With


' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0


Set OutApp = CreateObject("Outlook.Application")


For Each ws In ActiveWorkbook.Worksheets
If ws.Range("B49").Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail
.To = ws.Range("B49").Value
.CC = ""
.BCC = ""
.Subject = ""
.Display
.Attachments.Add PdfFile
End With
On Error GoTo 0


Set OutMail = Nothing
End If
Next ws


Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With












' Delete PDF file
Kill PdfFile


' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit


' Release the memory of object variable
Set OutlApp = Nothing

End Sub

Thank you both so much!

Both work but for some reason doesnt clear the cell after! Any reasons why?

Hi Roy,

I thought i provided the information required i do apologize. It would need to do both, so if i type in 500 it would add, if i typed in -500 it would subtract as it would be trying to add a negative?

You would be typing in J8:40, and it would be adding/subtracing from the cell to the left. (i8:400)

Please let me know if you are on the same wave length!

Thanks for your help, if i wanted to make this the case for section J8:400, so when you type in any cell in J8:400, it will add/subtract to the one beside it. So typing in J8 would add/subtract from I8, typing in J50 would add/subtract from I50 and so on

Hi all,

Hope everyone is keeping well!

Im not sure if a code or formula is required. What im looking to do is when i have a value in cell a1, if i type a value into cell a2, it will automatically add that value to cell a1. It will then clear the cell a2 ready for the next time a value is typed in it.

Any help would be appreciated!

Hi mumps,

I got this working after editing what you put slightly, i have attached the code to show you what i changed

Thank you very much for your help as id have had no clue!

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Application.ScreenUpdating = False
 Dim srcWS As Worksheet, desWB As Workbook, desWS As Worksheet
 Set srcWS = ThisWorkbook.Sheets("DataFeed")
 Set desWB = Workbooks.Open("X:\Joe Customer Service Documents\QuoteLog.xlsm") 'change path to suit your needs
 Set desWS = ActiveWorkbook.Sheets("QuoteLog")
 With desWS
 If Not IsEmpty(ThisWorkbook.Worksheets("Standard Quote Details").Cells(51, "CI")) Then _
 .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 9).Value = srcWS.Range("A2:I2").Value
 If Not IsEmpty(ThisWorkbook.Worksheets("Standard Quote Details").Cells(69, "CI")) Then _
 .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 9).Value = srcWS.Range("A3:I3").Value
 If Not IsEmpty(ThisWorkbook.Worksheets("Standard Quote Details").Cells(87, "CI")) Then _
 .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 9).Value = srcWS.Range("A4:I4").Value
 End With
 desWB.Close False
 Application.ScreenUpdating = True
End Sub

Hi Mumps,

Thank you for coming back to me, it comes up with an error on step 6 so not sure how to fix.

Thanks,

Joe

Good morning all,

Below i have a code for transferring data upon saving the document. I was wondering how i would make this work if the other workbook was not open but closed, does anyone know how this works or any place i can learn how to do this? Any help or advice would be greatly appreciated.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Application.ScreenUpdating = False
 Dim srcWS As Worksheet, desWS As Worksheet
 Set srcWS = ThisWorkbook.Sheets("DataFeed")
 Set desWS = Workbooks("QuoteLog.xlsm").Sheets("QuoteLog")
With desWS
If Not IsEmpty(ThisWorkbook.Worksheets("Standard Quote Details").Cells(51, "CI")) Then _
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 9).Value = srcWS.Range("A2:I2").Value
If Not IsEmpty(ThisWorkbook.Worksheets("Standard Quote Details").Cells(69, "CI")) Then _
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 9).Value = srcWS.Range("A3:I3").Value
If Not IsEmpty(ThisWorkbook.Worksheets("Standard Quote Details").Cells(87, "CI")) Then _
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 9).Value = srcWS.Range("A4:I4").Value
End With
 Application.ScreenUpdating = True
End Sub

I have another question, if i wanted to get this data to be sent across to another document which is not open, please can you advise how i may do that? As currently both documents need to be open but im trying to see if there is a way of getting the data sent across to a document which is not open.

Any help or advice would be greatly appreciated.

this seems so far to work perfectly, thank you so much!

Hi Roy,

Apologies i have read through them, i wasn't aware but i am now.

Sorry for any inconvenience caused.

Hi all,

Currently i have the below code which transfers data when the document is saved to another excel document. I would like to enhance this further by only transferring data if certain cells arent blank.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim srcWS As Worksheet, desWS As Worksheet
Set srcWS = ThisWorkbook.Sheets("DataFeed")
Set desWS = Workbooks("QuoteLog.xlsm").Sheets("QuoteLog")
With desWS
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(3, 3).Value = srcWS.Range("A2:C4").Value
.Cells(.Rows.Count, "E").End(xlUp).Offset(1).Resize(3, 5).Value = srcWS.Range("E2:I4").Value
End With
Application.ScreenUpdating = True
End Sub

So the above is the current where code is at now, but what i need it to do is if cell Ci51 is not blank on sheet "Standard Quote Details", then i need when saving the data from sheet "datafeed" a2 to i2 is transferred across, if Ci69 isnt blank then a3 to i3 is transferred across, if ci87 is not blank then a4 to i4 is transferred over. If all of them arent blank they all transfer, if one is blank and the other two arent then only two transfer over etc. As currently all 3 of them transfer over regardless and i have to manually delete out the ones i dont need.

This is great! all working now thank you for your help!!