Hi Team,
Please close the post as I got the solution.
https://www.mrexcel.com/board/…ax-value-formula.1197241/
Thank you.
Regards,
Rehaman.
Please note that on 14th December 2023 users will experience an expected outage whilst we make upgrades to our network. We anticipate this process may take a couple of hours and so we apologise in advance for any inconvenience.
Hi Team,
Please close the post as I got the solution.
https://www.mrexcel.com/board/…ax-value-formula.1197241/
Thank you.
Regards,
Rehaman.
Hi Team,
Unable to Edit my post so using reply option.
Here i have cross posted
Thank you.
Regards,
Rehaman.
Hi Team,
I am looking for the formula where if lookup value matches the lookuparray then formula should pick the max value for the match and return corresponding value.
for better understanding please refer the attached excel file.
I request you to kindly look into this and advise.
Thank you.
Regards,
Rehaman
Hi Team,
Solution has been received from "https://www.accessforums.net/showthread.php?t=85165&p=489055#post489055"
Thank you.
Regards,
Rehaman.
Hi Team,
Cross posted here "https://www.accessforums.net/showthread.php?t=85165&p=489046#post489046"
Note : Not able to edit the post.
thank you.
Hi Team,
I am trying to append the unmatched query but getting the error message as "Duplicate Output Destination".
What actually am trying is to identify the unmatched line.
Eg: in table "A" i have 2 records and in table "B" 3 records
and i want to append/insert unmatched query result in table "A".
Should compare or match between "Field1" in both the tables.
I request you to kindly advise on this.
Note: I will provide the link in case of cross posting.
Thank you.
Regards,
Rehaman.
Hi SO,
Before moving to Outlook 365 it was working fine and yes as you said I don't think that I can achieve the same in outlook 365.
Thanks for all your help and support.
Regards,
Rahaman
Hi SO,
Thanks for the reply.....
This coding showing only the default account not the shared mailbox ( configured using more setting -- advance and then add).
please see the below link for more clarity...
https://support.deakin.edu.au/…e0d2e8140ac47ae1cab3dc857
And I am aware if we configure shared mailbox as separate account then it will work but we don't have permission for this....
kindly advise.
Regards,
Rahaman.
Hi Team,
any update..? is this not possible......? Please advise.
Thank you
regards,
Rahaman.
Hi Team,
So far below coding was working fine to send email from particular account but recently we moved to Outlook 365 - 2013 version and now coding is not recognizing the account and i do not want to use SentOnBehalfOfName.
Kindly advise and help me with the coding.
Sub Which_Account_Number()
Dim OutApp As object,I As Long
Set OutApp = CreateObject("Outlook.Application")
For I = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
Next I
End Sub
Please note I don't want to use .SentOnBehalfOfName and any coding inside "thisoutlooksession"
10% paid and here is the transaction ID 50F38114HA831270X
Thanks in advance for all your help and support.
Cross posted here: https://www.excelforum.com/exc…ook-365-2013-version.html
Regards,
Rahaman
Hi Team,
I am in need of your help to complete this task.
I request you to kindly look into this and advice.
thanks in advance for all your help and support.
regards,
Rahaman.
Hi Team,
So far below coding was working fine to send email from particular account but recently we moved to Outlook 365 - 2013 version and now coding is not recognizing the account and i do not want to use SentOnBehalfOfName.
Kindly advise and help me with the coding.
Sub Which_Account_Number()
Dim OutApp As object,I As Long
Set OutApp = CreateObject("Outlook.Application")
For I = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
Next I
End Sub
Thanks in advance for all your help and support.
Cross posted in "https://www.excelforum.com/excel-programming-vba-macros/1234292-send-email-from-specific-account-outlook-365-2013-version.html"
Regards,
Rahaman
Re: VBA to enter value of one cell into corresponding cells in the same worksheet
See if this works for you...
Sub Test()
Dim SL As Object, A As Variant, i As Long
Set SL = CreateObject("system.collections.sortedlist")
With Sheets("Sandvik US Price List").Cells(1).CurrentRegion
A = .Value
For i = 2 To UBound(A, 1)
If Not SL.contains(A(i, 1)) Then
SL.Item(A(i, 1)) = VBA.Array(A(i, 2), A(i, 3))
End If
Next
End With
With Sheets("Sheet2").Cells(12, 1).CurrentRegion
A = .Value
.ClearContents
For i = 2 To UBound(A, 1)
If SL.contains(A(i, 2)) Then
A(i, 4) = SL(A(i, 2))(0): A(i, 5) = SL(A(i, 2))(1)
Else
A(i, 5) = "For quotation"
End If
Next
.Value = A
End With
End Sub
Display More
Re: Excel VB Copy & Print Range in Bulk
To print sheet "pic_format" Range("A1:F8") as jpg use the below code. or if you want the jpg in large size then increase the font size.
and Please try to adopt the code as per your requirement.
Sub print_JPG()
Dim Nm As Range, Acct As String
With Sheets("pic_format")
.Activate
Acct = .Range("A4").Value
Set Nm = .Range("A1:F8")
Nm.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
With .ChartObjects.Add(Left:=Nm.Left, Top:=Nm.Top, Width:=Nm.Width, Height:=Nm.Height)
.Name = "TempArea"
.Activate
ActiveChart.Paste
.Parent.ChartObjects("TempArea").Chart.Export "D:\" & Acct & ".jpg"
.Parent.ChartObjects("TempArea").Delete
End With
End With
End Sub
Display More
Re: Excel VB Copy & Print Range in Bulk
You are welcome.
Re: Excel VB Copy & Print Range in Bulk
Please try the below code and keep me posted on the working status.
Sub test()
Dim A As Variant, i As Long, dic As Object, n As Long, y As Variant, Nm As Range, e As Variant, sht As Worksheet
Set dic = CreateObject("Scripting.dictionary")
A = Worksheets("sales").Cells(1).CurrentRegion.Value
For i = 2 To UBound(A, 1)
If Not dic.exists(A(i, 1)) Then
Set dic(A(i, 1)) = CreateObject("Scripting.dictionary")
End If
If Not dic(A(i, 1)).exists(A(i, 2)) Then
dic(A(i, 1))(A(i, 2)) = VBA.Array(A(i, 1), A(i, 2), A(i, 3), A(i, 4), Empty)
Else
w = dic(A(i, 1))(A(i, 2))
w(3) = w(3) + A(i, 4)
dic(A(i, 1))(A(i, 2)) = w
End If
Next
A = Worksheets("outstanding").Cells(1).CurrentRegion.Value
For i = 2 To UBound(A, 1)
If dic.exists(A(i, 1)) Then
If dic(A(i, 1)).exists(A(i, 2)) Then
w = dic(A(i, 1))(A(i, 2))
w(4) = w(4) + A(i, 4)
dic(A(i, 1))(A(i, 2)) = w
End If
End If
Next
On Error Resume Next
Set sht = Sheets("Test")
If sht Is Nothing Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Test"
Set sht = Sheets("Test")
End If
y = dic.items
With Sheets("summary")
.Activate
.Cells(4, 1).CurrentRegion.Offset(1).ClearContents
For i = 0 To dic.Count - 1
With .Cells(5, 1).Offset(n).Resize(y(i).Count, 5)
.Value = Application.Transpose(Application.Transpose(y(i).items))
End With
n = n + y(i).Count
Next
.Cells(4, 1).CurrentRegion.Borders.Weight = 2
For Each e In dic.keys()
.Range("A4:E" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter 1, e
On Error Resume Next
Set Nm = .AutoFilter.Range.Offset(0, 0).Resize(.AutoFilter.Range.Rows.Count, .AutoFilter.Range.Columns.Count) _
.SpecialCells(xlCellTypeVisible)
Nm.Copy sht.Range("A1")
With sht
.Activate
.Range("A1").CurrentRegion.Columns.AutoFit
Set Nm = .Range("A1").CurrentRegion
Nm.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
With .ChartObjects.Add(Left:=Nm.Left, Top:=Nm.Top, Width:=Nm.Width, Height:=Nm.Height)
.Name = "TempArea"
.Activate
ActiveChart.Paste
.Parent.ChartObjects("TempArea").Chart.Export "D:\" & e & ".jpg"
.Parent.ChartObjects("TempArea").Delete
End With
.Range("A1").CurrentRegion.ClearContents
End With
Next
.AutoFilterMode = False
End With
Application.DisplayAlerts = False
sht.Delete
Sheets("summary").Activate
Application.DisplayAlerts = True
End Sub
Display More
Re: Vlookup in excel vba
See attached workbook, adopt as per your requirement if this how you wanted.
Option Explicit
Sub Test(dic As Object)
Dim A As Variant, i As Long
A = Sheets("Sheet2").Cells(1).CurrentRegion.Value
For i = 2 To UBound(A, 1)
If Not dic.exists(A(i, 1)) Then
dic.Item(A(i, 1)) = VBA.Array(A(i, 2), A(i, 3))
End If
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dic As Object
Application.EnableEvents = False
If Not Target Is Nothing And Target.Address = Sheets("Sheet1").Range("C3").Address Then
Set dic = CreateObject("Scripting.dictionary"): Test dic
If dic.exists(Target.Value) Then
Range("C4").Value = dic.Item(Target.Value)(0)
Range("C5").Value = dic.Item(Target.Value)(1)
End If
End If
Application.EnableEvents = True
End Sub
Display More
Re: Excel VB Copy & Print Range in Bulk
Is this how you wanted..?
Sub test()
Dim A As Variant, i As Long, dic As Object, n As Long, y As Variant
Set dic = CreateObject("Scripting.dictionary")
A = Worksheets("sales").Cells(1).CurrentRegion.Value
For i = 2 To UBound(A, 1)
If Not dic.exists(A(i, 1)) Then
Set dic(A(i, 1)) = CreateObject("Scripting.dictionary")
End If
If Not dic(A(i, 1)).exists(A(i, 2)) Then
dic(A(i, 1))(A(i, 2)) = VBA.Array(A(i, 1), A(i, 2), A(i, 3), A(i, 4), Empty)
Else
w = dic(A(i, 1))(A(i, 2))
w(3) = w(3) + A(i, 4)
dic(A(i, 1))(A(i, 2)) = w
End If
Next
A = Worksheets("outstanding").Cells(1).CurrentRegion.Value
For i = 2 To UBound(A, 1)
If dic.exists(A(i, 1)) Then
If dic(A(i, 1)).exists(A(i, 2)) Then
w = dic(A(i, 1))(A(i, 2))
w(4) = w(4) + A(i, 4)
dic(A(i, 1))(A(i, 2)) = w
End If
End If
Next
y = dic.items
With Sheets("summary")
.Cells(4, 1).CurrentRegion.Offset(1).ClearContents
For i = 0 To dic.count - 1
With .Cells(5, 1).Offset(n).Resize(y(i).count, 5)
.Value = Application.Transpose(Application.Transpose(y(i).items))
End With
n = n + y(i).count
Next
.Cells(4, 1).CurrentRegion.Borders.Weight = 2
End With
End Sub
Display More
Re: VBA Code: excel is hanging at some point
I have added two extra line in the code and this should work, please try.
Sub Test()
Dim Rng As Range, A As Variant, e As Variant, sht As Worksheet, n As Long, i As Long
On Error Resume Next
Set sht = ThisWorkbook.Sheets("Dispatch_load")
If sht Is Nothing Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Dispatch_load"
End If
n = 10: i = 0
With Sheets("AMC Agent Breakout")
.Activate
For Each e In Array("KAX0", "KAX1", "KAX2", "KAX3", "KAX4", "KAX5", "KAX6", "KAX7", "KAX8", "KAX9")
.Range("A1:R" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=8, Criteria1:=e
.Range("A1:R" & .Range("A" & .Rows.Count).End(xlUp).Row).AutoFilter Field:=18, Criteria1:="0"
Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows.Count - 1, .AutoFilter.Range.Columns.Count) _
.SpecialCells(xlCellTypeVisible)
If Not Rng Is Nothing Then
On Error Resume Next
Set sht = ThisWorkbook.Sheets("Agent&DRM")
If sht Is Nothing Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Agent&DRM"
End If
With Sheets("Agent&DRM")
.Activate
.UsedRange.Clear
' Added to clear the existing data
Rng.Copy .Range("C6")
.Columns("C:I").Delete Shift:=xlToLeft
.Columns("D:J").Delete Shift:=xlToLeft
.Columns("E:F").Delete Shift:=xlToLeft
.Range("T17").FormulaR1C1 = "AAX" & i
.Range("U17").FormulaR1C1 = "=SUM(R[-11]C[-17]:R[8983]C[-17])"
.Range("T17:U17").Copy
Sheets("Dispatch_load").Range("A" & n).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
n = n + 1: i = i + 1
End If
.AutoFilterMode = False
Set Rng = Nothing
' added to release the memory
Next
End With
End Sub
Display More